From 97cfa090cfe3d683d7e663258b64bd21f342892c Mon Sep 17 00:00:00 2001 From: Nate Begeman Date: Tue, 28 Feb 2006 18:08:54 +0000 Subject: [PATCH] Add support for "preprocessed FORTRAN" source *shudder* llvm-svn: 26423 --- Makefile.nagfortran | 4 +- filepp | 2733 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 2735 insertions(+), 2 deletions(-) create mode 100755 filepp diff --git a/Makefile.nagfortran b/Makefile.nagfortran index 7ce34e4611..b885ca34f9 100644 --- a/Makefile.nagfortran +++ b/Makefile.nagfortran @@ -39,13 +39,13 @@ clean:: $(F95) -w -S -O2 $< -o $@ $(NAGFORTRAN_FLAGS) %.f: %.F - $(CPP) -x c $< -o - $(CPPFLAGS) -traditional-cpp | $(SED) '/^# /d' > $@ + $(LEVEL)/filepp $< -o $@ -M $(SPEC_BENCH_DIR)/src/ $(FPPFLAGS) %.c: %.f90 $(F95) -w -S -O2 $< -o $@ $(NAGFORTRAN_FLAGS) %.f90: %.F90 - $(CPP) -x c $< -o - $(CPPFLAGS) -traditional-cpp | $(SED) '/^# /d' > $@ + $(LEVEL)/filepp $< -o $@ -M $(SPEC_BENCH_DIR)/src/ $(FPPFLAGS) CPPFLAGS += -I$(F95_DIR)/lib/NAGWare LDFLAGS += $(F95_DIR)/lib/NAGWare/quickfit.o -Xlinker -flat_namespace $(F95_DIR)/lib/NAGWare/libf97.dylib $(F95_DIR)/lib/NAGWare/libf96.a diff --git a/filepp b/filepp new file mode 100755 index 0000000000..a5b813022b --- /dev/null +++ b/filepp @@ -0,0 +1,2733 @@ +#!/usr/bin/perl -w +######################################################################## +# +# filepp is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING. If not, write to +# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +# +######################################################################## +# +# Project : File Preprocessor +# Filename : $RCSfile$ +# Author : $Author$ +# Maintainer : Darren Miller: darren@cabaret.demon.co.uk +# File version : $Revision$ +# Last changed : $Date$ +# Description : Main program +# Licence : GNU copyleft +# +######################################################################## + +package Filepp; + +use strict "vars"; +use strict "subs"; +# Used to all filepp to work with any char, not just ascii, +# feel free to remove this if it causes you problems +use bytes; + +# version number of program +my $VERSION = '1.7.1'; + +# list of paths to search for modules, normal Perl list + module dir +push(@INC, "/usr/local/share/filepp/modules"); + +# index of keywords supported and functions to deal with them +my %Keywords = ( + 'comment' => \&Comment, + 'define' => \&Define, + 'elif' => \&Elif, + 'else' => \&Else, + 'endif' => \&Endif, + 'error' => \&Error, + 'if' => \&If, + 'ifdef' => \&Ifdef, + 'ifndef' => \&Ifndef, + 'include' => \&Include, + 'pragma' => \&Pragma, + 'undef' => \&Undef, + 'warning' => \&Warning + ); + +# set of functions which process the file in the Parse routine. +# Processors are functions which take in a line and return the processed line. +# Note: this is done as a string rather than pointer to a function because +# it makes list easier to modify/remove from/print. +my @Processors = ( "Filepp::ParseKeywords", "Filepp::ReplaceDefines" ); +# processor types say what the processor should be run on: choice is: +# 0: Everything (default) +# 1: Full lines only (lines originating from Parse function) +# 2: Part lines only (lines originating from within keywords, eg: +# #if "condition", "condition" is a part line) +my %ProcessorTypes = ( + 'Filepp::ParseKeywords' => 1, + 'Filepp::ReplaceDefines' => 0 + ); + +# functions to run each time a new base input file is opened or closed +my @OpenInputFuncs = (); +my @CloseInputFuncs = (); + +# functions to run each time a new output file is opened or closed +my @OpenOutputFuncs = (); +my @CloseOutputFuncs = (); + +# safe mode is for the paranoid, when enabled turns off #pragma filepp, +# enabled by default +my $safe_mode = 0; + +# test for shebang mode, used for "filepp script", ie. executable file with +# "#!/usr/bin/perl /usr/local/bin/filepp" at the top +my $shebang = 1; + +# allow $keywordchar, $contchar, $optlineendchar and $macroprefix +# to be perl regexps +my $charperlre = 0; + +# character(s) which prefix environment variables - defaults to shell-style '$' +my $envchar = "\$"; + +# boolean determining whether line continuation is implicit if there are more +# open brackets than close brackets on a line +# disabled by default +my $parselineend = \&Filepp::ParseLineEnd; + +# character(s) which replace continuation char(s) - defaults to C-style nothing +my $contrepchar = ""; + +# character(s) which prefix keywords - defaults to C-style '#' +my $keywordchar; +if($charperlre) { $keywordchar = "\#"; } +else { $keywordchar = "\Q#\E"; } + +# character(s) which signifies continuation of a line - defaults to C-style '\' +my $contchar; +if($charperlre) { $contchar = "\\\\"; } +else { $contchar = "\Q\\\E"; } + +# character(s) which optionally signifies the end of a line - +# defaults to empty string '' +my $optlineendchar = ""; + +# character(s) which prefix macros - defaults to nothing +my $macroprefix = ""; + +# flag to use macro prefix in keywords (on by default) +my $macroprefixinkeywords = 1; + +# check if macros must occur as words when replacing, set this to '\b' if +# you prefer cpp style behaviour as default +my $bound = ''; + +# number of line currently being parsed (int) +my $line = 0; + +# file currently being parsed +my $file = ""; + +# list of input files +my @Inputfiles; + +# list of files to include macros from +my @Imacrofiles; + +# flag to control when output is written +my $output = 1; + +# name of outputfile - defaults to STDOUT +my $outputfile = ""; + +# overwrite mode - automatically overwrites old file with new file +my $overwrite = 0; + +# overwrite conversion mode - conversion from input filename to output filename +my $overwriteconv = ""; + +# list of keywords which have "if" functionality +my %Ifwords = ('if', '', + 'ifdef', '', + 'ifndef', ''); + +# list of keywords which have "else" functionality +my %Elsewords = ('else', '', + 'elif', ''); + +# list of keywords which have "endif" functionality +my %Endifwords = ('endif', ''); + +# current level of include files +my $include_level = -1; + +# suppress blank lines in header files (indexed by include level) +my $blanksuppopt = 0; +my @blanksupp; +# try to keep same number lines in output file as input file +my $preserveblank = 0; + +# counter of recursion level for detecting recursive macros +my $recurse_level = -1; + +# debugging info, 1=on, 0=off +my $debug = 0; +# send debugging info to stdout rather than stderr +my $debugstdout = 0; +# debug prefix character or string +my $debugprefix = ""; +# debug postfix character or string +my $debugpostfix = "\n"; + +# hash of macros defined - standard ones already included +my %Defines = ( + '__BASE_FILE__' => "", + '__DATE__' => "", + '__FILEPP_INPUT__' => "Generated automatically from __BASE_FILE__ by filepp", + '__FILE__' => $file, + '__INCLUDE_LEVEL__' => $include_level, + '__ISO_DATE__' => "", + '__LINE__' => $line, + '__NEWLINE__' => "\n", + '__NULL__' => "", + '__TAB__' => "\t", + '__TIME__' => "", + '__VERSION__' => $VERSION + ); +# hash of first chars in each macro +my %DefineLookup; +# length of longest and shortest define +my ($defmax, $defmin); +GenerateDefinesKeys(); + +# set default values for date and time +{ + # conversions of month number into letters (0-11) + my @MonthChars = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', + 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); + #prepare standard defines + my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isbst) = + localtime(time()); + $year += 1900; + $sec = sprintf("%02d", $sec); + $min = sprintf("%02d", $min); + $hour = sprintf("%02d", $hour); + $mday = sprintf("%02d", $mday); + $mon = sprintf("%02d", $mon); + Redefine("__TIME__", $hour.":".$min.":".$sec); + Redefine("__DATE__", $MonthChars[$mon]." ".$mday." ".$year); + $mon = sprintf("%02d", ++$mon); + Redefine("__ISO_DATE__", $year."-".$mon."-".$mday); +} + +# hash table for arguments to macros which need them +my %DefinesArgs = (); + +# hash table for functions which macros should call (if any) +my %DefinesFuncs = (); + +# eat-trailing-whitespace flag for each macro +my %EatTrail = (); + +# list of include paths +my @IncludePaths; + +# help string +my $usage = "filepp: generic file preprocessor, version ".$VERSION." +usage: filepp [options] inputfile(s) +options: + -b\t\tsuppress blank lines from include files + -c\t\tread input from STDIN instead of file + -Dmacro[=defn]\tdefine macros (same as #define) + -d\t\tprint debugging information + -dd\t\tprint verbose debugging information + -dl\t\tprint some (light) debugging information + -dpre char\tprefix all debugging information with char + -dpost char\tpostfix all debugging information with char, defaults to newline + -ds\t\tsend debugging info to stdout rather than stderr + -e\t\tdefine all environment variables as macros + -ec char\tset environment variable prefix char to \"char\" (default \$) + -ecn\t\tset environment variable prefix char to nothing (default \$) + -h\t\tprint this help message + -Idir\t\tdirectory to search for include files + -imacros file\tread in macros from file, but discard rest of file + -k\t\tturn off parsing of all keywords, just macro expansion is done + -kc char\tset keyword prefix char to \"char\" (defaults to #) + -lc char\tset line continuation character to \"char\" (defaults to \\) + -lec char\tset optional keyword line end char to \"char\" + -lr char\tset line continuation replacement character to \"char\" + -lrn\t\tset line continuation replacement character to newline + -m module\tload module + -mp char\tprefix all macros with \"char\" (defaults to no prefix) + -mpnk\t\tdo not use macro prefix char in keywords + -Mdir\t\tdirectory to search for filepp modules + -o output\tname of output file (defaults to stdout) + -ov\t\toverwrite mode - output file will overwrite input file + -ovc IN=OUT\toutput file(s) will have be input file(s) with IN conveted to OUT + -pb\t\tpreseve blank lines in output that would normally be removed + -s\t\trun in safe mode (turns off pragma keyword) + -re\t\ttreat keyword and macro prefixes and line cont chars as reg exps + -u\t\tundefine all predefined macros + -v\t\tprint version and exit + -w\t\tturn on word boundaries when replacing macros + all other arguments are assumed to be input files +"; + + +############################################################################## +# SetDebug - controls debugging level +############################################################################## +sub SetDebug +{ + $debug = shift; + Debug("Debugging level set to $debug", 1); +} + + +############################################################################## +# Debugging info +############################################################################## +sub Debug +{ + # print nothing if not debugging + if($debug == 0) { return; } + my $msg = shift; + my $level = 1; + # check if level has been provided + if($#_ > -1) { $level = shift; } + if($level <= $debug) { + # if currently parsing a file show filename and line number + if($file ne "" && $line > 0) { + $msg = $file.":".$line.": ".$msg; + } + # else show program name + else { $msg = "filepp: ".$msg; } + if($debugstdout) { + print(STDOUT $debugprefix.$msg.$debugpostfix); + } + else { + print(STDERR $debugprefix.$msg.$debugpostfix); + } + } +} + + +############################################################################## +# Standard error handler. +# #error msg - print error message "msg" and exit +############################################################################## +sub Error +{ + my $msg = shift; + # close and delete output file if created + close(OUTPUT); + if($outputfile ne "-") { # output is not stdout + my $inputfile; + my $found = 0; + # do paranoid check to make sure we are not deleting an input file + foreach $inputfile (@Inputfiles) { + if($outputfile eq $inputfile) { $found = 1; last; } + } + # delete output file + if($found == 0) { unlink($outputfile); } + } + # print error message + $debug = 1; + Debug($msg, 0); + exit(1); +} + + +############################################################################## +# SafeMode - turns safe mode on +############################################################################## +sub SafeMode +{ + $safe_mode = 1; + Debug("Filepp safe mode enabled", 2); +} + + +############################################################################## +# CleanStart($sline) - strip leading whitespace from start of $sline. +############################################################################## +sub CleanStart +{ + my $sline = shift; + for($sline) { + # '^' = start of line, '\s+' means all whitespace, replace with nothing + s/^\s+//; + } + return $sline; +} + + +############################################################################## +# Strip($sline, $char, $level) - strip $char's from start and end of $sline +# removes up to $level $char's from start and end of line, it is not an +# error if $level chars do not exist at the start or end of line +############################################################################## +sub Strip +{ + my $sline = shift; + my $char = shift; + my $level = shift; + # strip leading chars from line + $sline =~ s/\A([$char]{0,$level})//g; + # strip trailing chars from line + $sline =~ s/([$char]{0,$level})\Z//g; + return $sline; +} + + +############################################################################## +# SetMacroPrefix $string - prefixs all macros with $string +############################################################################## +sub SetMacroPrefix +{ + $macroprefix = shift; + # make sure prefix will not be treated as a Perl regular expression + if(!$charperlre) { $macroprefix = "\Q$macroprefix\E"; } + Debug("Setting macro prefix to <".$macroprefix.">", 2); +} + + +############################################################################## +# SetKeywordchar $string - sets the first char(s) of each keyword to +# something other than "#" +############################################################################## +sub SetKeywordchar +{ + $keywordchar = shift; + # make sure char will not be treated as a Perl regular expression + if(!$charperlre) { $keywordchar = "\Q$keywordchar\E"; } + Debug("Setting keyword prefix character to <".$keywordchar.">", 2); +} + +############################################################################## +# GetKeywordchar - returns the current keywordchar +############################################################################## +sub GetKeywordchar +{ + return $keywordchar; +} + + +############################################################################## +# SetContchar $string - sets the line continuation char to something other +# than "\" +############################################################################## +sub SetContchar +{ + $contchar = shift; + # make sure char will not be treated as a Perl regular expression + if(!$charperlre) { $contchar = "\Q$contchar\E"; } + Debug("Setting line continuation character to <".$contchar.">", 2); +} + + +############################################################################## +# SetContrepchar $string - sets the replace of the line continuation char to +# something other than "" +############################################################################## +sub SetContrepchar +{ + $contrepchar = shift; + Debug("Setting line continuation replacement character to <".$contrepchar.">", 2); +} + + +############################################################################## +# SetOptLineEndchar $string - sets the optional line end char to something +# other than "" +############################################################################## +sub SetOptLineEndchar +{ + $optlineendchar = shift; + # make sure char will not be treated as a Perl regular expression + if(!$charperlre) { $optlineendchar = "\Q$optlineendchar\E"; } + Debug("Setting optional line end character to <".$optlineendchar.">", 2); +} + + +############################################################################## +# SetEnvchar $string - sets the first char(s) of each defined environment +# variable to $string - NOTE: change only takes effect when DefineEnv run +############################################################################## +sub SetEnvchar +{ + $envchar = shift; + Debug("Setting environment variable prefix character to <".$envchar.">",2); +} + +############################################################################## +# RunProcessors $string, $calledfrom +# run the current processing chain on the string +# $string is the string to be processed and should be returned by the processor +# $calledfrom says where the processors are called from, the choice is: +# +# 0 or default: Part line (from within a keyword) - if called recursively +# runs all processors AFTER current processor, then continues with processing. +# This is used when a keyword want to run all remaining processors on a line +# before doing its keyword task. +# +# 1: Full line (from Parse function) - if called recursively runs all +# processors BEFORE current processor, then continues with processing +# +# 2: Part line (from within a keyword) - if called recursively runs all +# processors BEFORE current processor, then continues with processing. +# This is used when keywords are using text taken from somewhere other than +# the current line, this text needs to go through the same processors as +# the current line has been through so it can "catch up" (eg: regexp.pm). +# +############################################################################## +my @Running; +my @Currentproc; +sub RunProcessors +{ + my $string = shift; + my $calledfrom = 0; + if($#_ > -1) { $calledfrom = shift; } + my $i; + + # turn off macoprefix if in a keyword + my $tmpprefix = ""; + if($calledfrom != 1 && $macroprefixinkeywords == 0) { + $tmpprefix = $macroprefix; + $macroprefix = ""; + } + + # These tests are done to make RunProcessors recursion safe. + # If RunProcessors is called from with a function that was itself called + # by RunProcessors, then the second calling of RunProcessors will only + # execute the processors before the currently running processor in the + # chain. + my $recursing = 0; + my $firstproc = 0; + my $lastproc = $#Processors; + if($Running[$include_level]) { + if($calledfrom == 0) { + $firstproc = $Currentproc[$include_level] + 1; + } + else { + $lastproc = $Currentproc[$include_level] - 1; + } + $recursing = 1; + } + else { $Running[$include_level] = 1; } + + for($i = $firstproc; $i <= $lastproc; $i++) { + if(!$recursing) { $Currentproc[$include_level] = $i; } + # called from anywhere (default) + if($ProcessorTypes{$Processors[$i]} == 0 || + # called from keyword (part lines only - within keywords) + (($calledfrom == 0 || $calledfrom == 2) && + $ProcessorTypes{$Processors[$i]} == 2) || + # called from Parse function (whole lines only) + ($calledfrom == 1 && $ProcessorTypes{$Processors[$i]} == 1)) { + # run processor +# Debug("Running processor $Processors[$i] on \"$string\"", 2); + $string = $Processors[$i]->($string); + } + # check that no processors have been deleted (bigdef.pm) + if($lastproc > $#Processors) { $lastproc = $#Processors; } + } + + if(!$recursing) { $Running[$include_level] = 0; } + + # return macro prefix to its former glory + if($calledfrom != 1 && $macroprefixinkeywords == 0) { + $macroprefix = $tmpprefix; + } + + return $string; +} + +############################################################################## +# PrintProcessors +# print the current processing chain +############################################################################## +sub PrintProcessors +{ + my $processor; + Debug("Current processing chain:", 3); + my $i = 0; + foreach $processor (@Processors) { + Debug($processor." type ".$ProcessorTypes{$Processors[$i]}, 3); + $i++; + } +} + +############################################################################## +# AddProcessor(function[, first[, type]]) +# add a line processor to processing chain, defaults to end of chain +# if "first" is set to one adds processor to start of chain +############################################################################## +sub AddProcessor +{ + my $function = shift; + my $first = 0; + my $type = 0; + # check if flag to add processor to start of chain is set + if($#_ > -1) { $first = shift; } + # check if processor has a type + if($#_ > -1) { $type = shift; } + # adding processor to start of chasin + if($first) { + @Processors = reverse(@Processors); + } + push(@Processors, $function); + if($first) { + @Processors = reverse(@Processors); + } + $ProcessorTypes{$function} = $type; + Debug("Added processor ".$function." of type ".$type, 2); + if($debug > 1) { PrintProcessors(); } +} + +############################################################################## +# AddProcessorAfter(function, processor[, type]) +# add a line processor to processing chain immediately after an existing +# processor, if existing processor not found, new processor is added to +# end of chain +############################################################################## +sub AddProcessorAfter +{ + my $function = shift; + my $existing = shift; + my $type = 0; + # check if processor has a type + if($#_ > -1) { $type = shift; } + my $i = 0; + my $found = 0; + my @CurrentProcessors = @Processors; + my $processor; + # reset processing chain + @Processors = (); + foreach $processor (@CurrentProcessors) { + push(@Processors, $processor); + if(!$found) { + # check done as regular expression for greater flexibility + if($processor =~ /$existing/) { + push(@Processors, $function); + $found = 1; + } + } + } + if(!$found) { + Warning("Did not find processor $existing in chain, processor $processor added to end of list"); + AddProcessor($function, 0, $type); + return; + } + $ProcessorTypes{$function} = $type; + Debug("Added processor ".$function." of type ".$type, 2); + if($debug > 1) { PrintProcessors(); } +} + +############################################################################## +# AddProcessorBefore(function, processor[, type]) +# add a line processor to processing chain immediately after an existing +# processor, if existing processor not found, new processor is added to +# end of chain +############################################################################## +sub AddProcessorBefore +{ + my $function = shift; + my $existing = shift; + my $type = 0; + # check if processor has a type + if($#_ > -1) { $type = shift; } + my $i = 0; + my $found = 0; + my @CurrentProcessors = @Processors; + my $processor; + # reset processing chain + @Processors = (); + foreach $processor (@CurrentProcessors) { + if(!$found) { + # check done as regular expression for greater flexibility + if($processor =~ /$existing/) { + push(@Processors,$function); + $found = 1; + } + } + push(@Processors, $processor); + } + if(!$found) { + Warning("Did not find processor $existing in chain, processor $processor added to start of list"); + AddProcessor($function, 1, $type); + return; + } + $ProcessorTypes{$function} = $type; + Debug("Added processor ".$function." of type ".$type, 2); + if($debug > 1) { PrintProcessors(); } +} + +############################################################################## +# RemoveProcessor(function) +# remove a processor name "function" from list +############################################################################## +sub RemoveProcessor +{ + my $function = shift; + my $i = 0; + # find function + while($i <= $#Processors && $Processors[$i] ne $function) { $i++; } + # check function found + if($i > $#Processors) { + Warning("Attempt to remove function ".$function. + " which does not exist"); + return; + } + # remove function + for(; $i<$#Processors; $i++) { + $Processors[$i] = $Processors[$i+1]; + } + pop(@Processors); + delete($ProcessorTypes{$function}); + Debug("Removed processor ".$function, 2); + PrintProcessors(); +} + + +############################################################################## +# Add a function to run each time a base file is opened +############################################################################## +sub AddOpenInputFunc +{ + my $func = shift; + push(@OpenInputFuncs, $func); +} + +############################################################################## +# Add a function to run each time a base file is closed +############################################################################## +sub AddCloseInputFunc +{ + my $func = shift; + push(@CloseInputFuncs, $func); +} + +############################################################################## +# Add a function to run each time a base file is opened +############################################################################## +sub AddOpenOutputFunc +{ + my $func = shift; + push(@OpenOutputFuncs, $func); +} + +############################################################################## +# Add a function to run each time a base file is closed +############################################################################## +sub AddCloseOutputFunc +{ + my $func = shift; + push(@CloseOutputFuncs, $func); +} + + +############################################################################## +# AddKeyword(keyword, function) +# Define a new keyword, when keyword (preceded by keyword char) is found, +# function is run on the remainder of the line. +############################################################################## +sub AddKeyword +{ + my $keyword = shift; + my $function = shift; + $Keywords{$keyword} = $function; + Debug("Added keyword ".$keyword." which runs ".$function, 2); +} + + +############################################################################## +# RemoveKeyword(keyword) +# Keyword is deleted from list, all occurrences of keyword found in +# document are ignored. +############################################################################## +sub RemoveKeyword +{ + my $keyword = shift; + delete $Keywords{$keyword}; + # sort keywords index into reverse order, this ensures #if[n]def comes + # before #if when comparing input with keywords + Debug("Removed keyword ".$keyword, 2); +} + + +############################################################################## +# RemoveAllKeywords - removes all current keywords. +############################################################################## +sub RemoveAllKeywords +{ + %Keywords = (); + Debug("Removed all current keywords", 2); +} + + +############################################################################## +# AddIfword - adds a keyword to ifword hash +############################################################################## +sub AddIfword +{ + my $ifword = shift; + $Ifwords{$ifword} = ''; + Debug("Added Ifword: ".$ifword, 2); +} + +############################################################################## +# RemoveIfword - removes a keyword from ifword hash +############################################################################## +sub RemoveIfword +{ + my $ifword = shift; + delete $Ifwords{$ifword}; + Debug("Removed Ifword: ".$ifword, 2); +} + +############################################################################## +# AddElseword - adds a keyword to elseword hash +############################################################################## +sub AddElseword +{ + my $elseword = shift; + $Elsewords{$elseword} = ''; + Debug("Added Elseword: ".$elseword, 2); +} + +############################################################################## +# RemoveElseword - removes a keyword from elseword hash +############################################################################## +sub RemoveElseword +{ + my $elseword = shift; + delete $Elsewords{$elseword}; + Debug("Removed Elseword: ".$elseword, 2); +} + +############################################################################## +# AddEndifword - adds a keyword to endifword hash +############################################################################## +sub AddEndifword +{ + my $endifword = shift; + $Endifwords{$endifword} = ''; + Debug("Added Endifword: ".$endifword, 2); +} + +############################################################################## +# RemoveEndifword - removes a keyword from endifword hash +############################################################################## +sub RemoveEndifword +{ + my $endifword = shift; + delete $Endifwords{$endifword}; + Debug("Removed Endifword: ".$endifword, 2); +} + + +############################################################################## +# AddIncludePath - adds another include path to the list +############################################################################## +sub AddIncludePath +{ + my $path = shift; + push(@IncludePaths, $path); + Debug("Added include path: \"".$path."\"", 2); +} + + +############################################################################## +# AddModulePath - adds another module search path to the list +############################################################################## +sub AddModulePath +{ + my $path = shift; + push(@INC, $path); + Debug("Added module path: \"".$path."\"", 2); +} + + +# set if file being written to has same name as input file +my $same_file = ""; + +############################################################################## +# OpenOutputFile - opens the output file +############################################################################## +sub OpenOutputFile +{ + $outputfile = shift; + Debug("Output file: ".$outputfile, 1); + + # check for outputfile name, if not specified use STDOUT + if($outputfile eq "") { $outputfile = "-"; } + + # output is not stdout and file with that name already exists + if($outputfile ne "-" && FileExists($outputfile) ) { + $same_file = $outputfile; + # paranoid: check file is writable and normal file + if(-w $outputfile && -f $outputfile) { + $outputfile = $outputfile.".fpp".$$; + my $i=0; # paranoid: check temp file does not exist + while(FileExists($outputfile)) { + $outputfile = $outputfile.$i; + $i++; + if($i >= 10) { Error("Cound not get temp filename"); } + } + } + else { + Error("Cannot read or write to ".$outputfile); + } + } + if(!open(OUTPUT, ">".$outputfile)) { + Error("Cannot open output file: ".$outputfile); + } + # run any open functions + my $func; + foreach $func (@OpenOutputFuncs) { $func->(); } +} + + +############################################################################## +# CloseOutputFile - close the output file +############################################################################## +sub CloseOutputFile +{ + # run any close functions + my $func; + foreach $func (@CloseOutputFuncs) { $func->(); } + close(OUTPUT); + + # if input and output have same name, rename output to input now + if($same_file ne "") { + if(rename($same_file, $same_file."~") == -1) { + Error("Could not rename ".$same_file." ".$same_file."~"); + } + if(rename($outputfile, $same_file) == -1) { + Error("Could not rename ".$outputfile." ".$same_file); + } + } + # reset same_file + $same_file = ""; +} + + +############################################################################## +# ChangeOutputFile - change the output file +############################################################################## +sub ChangeOutputFile +{ + CloseOutputFile(); + $outputfile = shift; + OpenOutputFile($outputfile); +} + + +############################################################################## +# AddInputFile - adds another input file to the list +############################################################################## +sub AddInputFile +{ + my $file = shift; + push(@Inputfiles, $file); + Debug("Added input file: \"".$file."\"", 2); +} + + +############################################################################## +# UseModule(module) +# Module "module.pm" is used, "module.pm" can be any perl module and can use +# or replace any of the functions in this package +############################################################################## +sub UseModule +{ + my $module = shift; + Debug("Loading module ".$module, 1); + require $module; + if($@) { Error($@); } +} + + +############################################################################## +# find end of next word in $sline, assumes leading whitespace removed +############################################################################## +sub GetNextWordEnd +{ + my $sline = shift; + # check for whitespace in this string + if($sline =~ /\s/) { + # return length of everything up to first whitespace + return length($`); + } + # whitespace not found, return length of the whole string + return length($sline); +} + + +############################################################################## +# Print current table of defines - used for debugging +############################################################################## +sub PrintDefines +{ + my $define; + Debug("Current ".$keywordchar."define's:", 3); + foreach $define (keys(%Defines)) { + Debug(" macro:\"".$define."\", definition:\"".$Defines{$define}."\"",3); + } +} + + +############################################################################## +# DefineEnv - define's all environment variables to macros, each prefixed +# by $envchar +############################################################################## +sub DefineEnv +{ + my $macro; + Debug("Defining environment variables as macros", 2); + foreach $macro (keys(%ENV)) { + Define($envchar.$macro." ".$ENV{$macro}); + } +} + + +############################################################################## +# Find out if arguments have been used with macro +############################################################################## +sub DefineArgsUsed +{ + my $string = shift; + # check '(' is first non-whitespace char after macro + if($string =~ /^\s*\(/) { + return 1; + } + return 0; +} + + +############################################################################## +# ParseArgs($string) - find the arguments in a string of form +# (arg1, arg2, arg3...) trailing chars +# or +# arg1, arg2, arg3... +############################################################################## +sub ParseArgs +{ + my $string = shift; + $string = CleanStart($string); + my @Chars; + my $char; + # split string into chars (can't use split coz it deletes \n at end) + for($char=0; $char ')', '"' => '"', '\'' => '\''); + 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 - 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 ) or a local + # include file (#include "filename") + if(substr($filename, 0, 1) eq "<") { + $sysinclude = 1; + # remove <> from filename + $filename = substr($filename, 1); + ($filename) = split(/\>/, $filename, 2); + } + elsif(substr($filename, 0, 1) eq "\"") { + # remove double quotes from filename + $filename = substr($filename, 1); + ($filename) = split(/\"/, $filename, 2); + } + # else assume filename given without "" or <>, naughty but allowed + + # check for file in current directory + if($sysinclude == 0) { + # get name of directory base file is in + my $dir = ""; + if($file =~ /\//) { + my @Dirs = split(/(\/)/, $file); + for($i=0; $i<$#Dirs; $i++) { + $dir = $dir.$Dirs[$i]; + } + } + if(FileExists($dir.$filename)) { + $fullname = $dir.$filename; + $found = 1; + } + } + + # search for file in include paths, first path on command line first + $i = 0; + while($found == 0 && $i <= $#IncludePaths) { + $fullname = $IncludePaths[$i]."/".$filename; + if(FileExists($fullname)) { $found = 1; } + $i++; + } + + # include file if found, error if not + if($found == 1) { + Debug("Including file: \"".$fullname."\"", 1); + # recursively call Parse + Parse($fullname); + } + else { + Warning("Include file \"".$filename."\" not found", 1); + } +} + + + +############################################################################## +# Pragma filepp Function Args +# Pragma executes a filepp function, everything following the function name +# is passed as arguments to the function. +# The format is: +# #pragma filepp function args... +# If pragma is not followed by "filepp", it is ignored. +############################################################################## +sub Pragma +{ + my $input = shift; + + # check for "filepp" in string + if($input =~ /^filepp\b/) { + my ($function, $args); + ($input, $function, $args) = split(/\s/, $input, 3); + if($function) { + if(!$args) { $args = ""; } + if($safe_mode) { + Debug("Safe mode enabled, NOT running: ".$function."(".$args.")", 1); + } + else { + my @Args = ParseArgs($args); + Debug("Running function: ".$function."(".$args.")", 1); + $function->(@Args); + } + } + } +} + + +############################################################################## +# Turn normal output on/off (does not affect any output produced by keywords) +# 1 = on, 0 = off +############################################################################## +sub SetOutput +{ + $output = shift; + Debug("Output set to ".$output, 2); +} + + +############################################################################## +# Turn blank suppression on and off at this include level +# 1 = on, 0 = off +############################################################################## +sub SetBlankSupp +{ + $blanksupp[$include_level] = shift; + Debug("Blank suppression set to ".$blanksupp[$include_level], 2); +} + + +############################################################################## +# Reset blank suppression to command-line value (except at level 0) +############################################################################## +sub ResetBlankSupp +{ + if($include_level == 0) { + $blanksupp[$include_level] = 0; + } else { + $blanksupp[$include_level] = $blanksuppopt; + } + Debug("Blank suppression reset to ".$blanksupp[$include_level], 2); +} + + +############################################################################## +# Set if macros are only replaced if the macro is a 'word' +############################################################################## +sub SetWordBoundaries +{ + my $on = shift; + if($on) { + $bound = '\b'; + Debug("Word Boundaries turned on", 2); + } + else { + $bound = ''; + Debug("Word Boundaries turned off", 2); + } +} + +############################################################################## +# DEPRECATED - this function will be removed in later versions, use Set +# Toggle if macros are only replaced if the macro is a 'word' +############################################################################## +sub ToggleWordBoundaries +{ + if($bound eq '\b') { SetWordBoundaries(1); } + else { SetWordBoundaries(0); } +} + + +############################################################################## +# Set treating keywordchar, contchar, macroprefix and optlineendchar as +# Perl regexps +############################################################################## +sub SetCharPerlre +{ + $charperlre = shift; + Debug("Characters treated as Perl regexp's : ".$charperlre, 2); +} + + +############################################################################## +# Undef a previously defined variable, usage: +# #undef $macro +############################################################################## +sub Undef +{ + my $macro = shift; + my $i; + + # separate macro from any trailing garbage + $macro = substr($macro, 0, GetNextWordEnd($macro)); + + # delete macro from table + delete $Defines{$macro}; + delete $DefinesArgs{$macro}; + delete $DefinesFuncs{$macro}; + + # and remove its eat-trailing-whitespace flag + if(CheckEatTrail($macro)) { delete $EatTrail{$macro}; } + + # regenerate keys + GenerateDefinesKeys(); + + Debug("Undefined macro \"".$macro."\"", 2); + if($debug > 1) { PrintDefines(); } +} + + +############################################################################## +# UndefAll - undefines ALL macros +############################################################################## +sub UndefAll +{ + %Defines = (); + %DefineLookup = (); + %EatTrail = (); + $defmin = $defmax = 0; + Debug("Undefined ALL macros", 2); + if($debug > 1) { PrintDefines(); } +} + + +############################################################################## +# #warning msg - print warning message "msg" +############################################################################## +sub Warning +{ + my $msg = shift; + my $lastdebug = $debug; + $debug = 1; + Debug($msg, 1); + $debug = $lastdebug; +} + + +############################################################################## +# ParseLineEnd - takes in line from input most recently read and checks +# if line should be continued (ie. next line in input read and appended +# to current line). +# Returns two values: +# $more - boolean, 1 = read another line from input to append to this one +# 0 = no line continuation +# $line - the line to be read. If any modification needs to be done to the +# line for line contination, it is done here. +# Example: if line is to be continued: set $more = 1, then +# remove line continuation character and newline from end of +# $line and replace with line continuation character. +############################################################################## +sub ParseLineEnd +{ + my $thisline = shift; + my $more = 0; + # check if end of line has a continuation char, if it has get next line + if($thisline =~ /$contchar$/) { + $more = 1; + # remove backslash and newline + $thisline =~ s/$contchar\n\Z//; + # append line continuation character + $thisline = $thisline.$contrepchar; + } + return ($more, $thisline); +} + + +############################################################################## +# Set name of function to take check if line shoule be continued +############################################################################## +sub SetParseLineEnd +{ + my $func = shift; + $parselineend = $func; +} + +############################################################################## +# Get name of function to take check if line shoule be continued +############################################################################## +sub GetParseLineEnd +{ + return $parselineend; +} + + +############################################################################## +# GetNextLine - returns the next line of the current INPUT line, +# line continuation is taken care of here. +############################################################################## +sub GetNextLine +{ + my $thisline = ; + if($thisline) { + Redefine("__LINE__", ++$line); + my $more = 0; + ($more, $thisline) = $parselineend->($thisline); + while($more) { + Debug("Line continuation", 2); + my $nextline = ; + if(!$nextline) { return $thisline; } + # increment line count + Redefine("__LINE__", ++$line); + ($more, $thisline) = $parselineend->($thisline.$nextline); + # maintain same number of lines in input as output + if($preserveblank) { Filepp::Output("\n"); } + } + } + return $thisline; +} + + +############################################################################## +# Write($string) - writes $string to OUTPUT file +############################################################################## +sub Write +{ + my $string = shift; + print(OUTPUT $string); +} + + +############################################################################## +# Output($string) - conditionally writes $string to OUTPUT file +############################################################################## +sub Output +{ + my $string = shift; + if($output) { Write($string); } +} + +# counter for number of #if[n][def] loops currently in +my $iflevel = 0; +# flag to control when to write output +my @Writing = (1); # initialise default to 'writing' +# flag to show if current 'if' block has passed a 'true if' +my @Ifdone = (0); # initialise first to 'not passed true if' + +############################################################################## +# Keyword parsing routine +############################################################################## +sub ParseKeywords +{ + # input is next line in file + my $inline = shift; + my $outline = ""; + + my $thisline = $inline; + my $keyword; + my $found = 0; + # remove whitespace from start of line + $thisline = CleanStart($thisline); + # check if first char on line is a # + if($thisline && $thisline =~ /^$keywordchar/) { + # remove "#" and any following whitespace + $thisline =~ s/^$keywordchar\s*//g; + # remove the optional end line char + if($optlineendchar ne "") { + $thisline =~ s/$optlineendchar\Z//g; + } + # check for keyword + if($thisline && $thisline =~ /^\w+\b/ && exists($Keywords{$&})) { + $keyword = $&; + $found = 1; + # remove newline from line + chomp($thisline); + # remove leading whitespace and keyword from line + my $inline = CleanStart(substr($thisline, length($keyword))); + + # check for 'if' style keyword + if(exists($Ifwords{$keyword})) { + # increment ifblock level and set ifdone to same + # value as previous block + $iflevel++; + $Ifdone[$iflevel] = 0; + $Writing[$iflevel] = $Writing[$iflevel - 1]; + if(!$Writing[$iflevel]) { $Ifdone[$iflevel] = 1; } + } + # check for out of place 'else' or 'endif' style keyword + elsif($iflevel <= 0 && (exists($Elsewords{$keyword}) || + exists($Endifwords{$keyword}) )) { + Warning($keywordchar.$keyword." found without preceding ". + $keywordchar."[else]ifword"); + } + + # decide if to run 'if' or 'else' keyword + if(exists($Ifwords{$keyword}) || exists($Elsewords{$keyword})){ + if(!($Ifdone[$iflevel])) { + # check return value of 'if' + if($Keywords{$keyword}->($inline)) { + $Ifdone[$iflevel] = 1; + $Writing[$iflevel] = 1; + } + else { $Writing[$iflevel] = 0; } + } + else { $Writing[$iflevel] = 0; } + } + # check for 'endif' style keyword + elsif(exists($Endifwords{$keyword})) { + # run endif keyword and decrement iflevel if true + if($Keywords{$keyword}->($inline)) { $iflevel--; } + } + # run all other keywords + elsif($Writing[$iflevel]) { $Keywords{$keyword}->($inline); } + + # write a blank line if preserving blank lines + # (assumes keywords have no output) + if($preserveblank) { $outline = $outline."\n"; } + + } # keyword if statement + } + # no keywords in line - write line to file if not #ifdef'ed out + if(!$found && $Writing[$iflevel]) { + $outline = $outline.$inline; + } + # keep same number of files in output and input + elsif(!$found && $preserveblank) { $outline = $outline."\n"; } + + return $outline; +} + +############################################################################## +# Main parsing routine +############################################################################## +sub Parse +{ + # change file being parsed to this file, remember last filename so + # it can be returned at the end + my $lastparse = $file; + $file = shift; + + Debug("Parsing ".$file."...", 1); + Redefine("__FILE__", $file); + + # reset line count, remembering previous count for future reference + my $lastcount = $line; + $line = 0; + Redefine("__LINE__", $line); + + # increment include level + Redefine("__INCLUDE_LEVEL__", ++$include_level); + + # set blank line suppression: + # no suppression for top level files + if($include_level == 0) { + $blanksupp[$include_level] = 0; + } + # include level 1 - set suppression to command line given value + elsif($include_level == 1) { + # inherit root value if set + if($blanksupp[0]) { $blanksupp[$include_level] = 1; } + else {$blanksupp[$include_level] = $blanksuppopt; } + } + # all other include levels - keep suppression at existing value + else { + $blanksupp[$include_level] = $blanksupp[$include_level - 1]; + } + + # reset RunProcessors function for this file + $Running[$include_level] = 0; + $Currentproc[$include_level] = 0; + + # open file and set its handle to INPUT + local *INPUT; + if(!open(INPUT, $file)) { + Error("Could not open file ".$file); + } + + # if a base file, run any initialisation functions + if($include_level == 0) { + my $func; + foreach $func (@OpenInputFuncs) { $func->(); } + } + + # parse each line of file + $_ = GetNextLine(); + # if in "shebang" mode, throw away first line (the #!/blah bit) + if($shebang) { + # check for "#!...perl ...filepp..." + if($_ && $_ =~ /^\#\!.*perl.+filepp/) { + Debug("Skipping first line (shebang): ".$_, 1); + $_ = GetNextLine(); + } + } + + while($_) { + # unless blank lines are suppressed at this include level + unless($blanksupp[$include_level] && /^\s*$/) { + # run processing chain (defaults to ReplaceDefines) + $_ = RunProcessors($_, 1); + # write output to file or STDOUT + if($output) { Write($_); } + } + $_ = GetNextLine(); + } + + # run any close functions + if($include_level == 0) { + my $func; + foreach $func (@CloseInputFuncs) { $func->(); } + } + + # check all #if blocks have been closed at end of parsing + if($lastparse eq "" && $iflevel > 0) { Warning("Unterminated if block"); } + + # close file + close(INPUT); + Debug("Parsing ".$file." done. (".$line." lines processed)", 1); + + # reset $line + $line = $lastcount; + Redefine("__LINE__", $line); + + # reset $file + $file = $lastparse; + Redefine("__FILE__", $file); + if($file ne "") { + Debug("Parsing returned to ".$file." at line ".$line, 1); + } + + # decrement include level + Redefine("__INCLUDE_LEVEL__", --$include_level); + +} + +############################################################################## +# Main routine +############################################################################## + +# parse command line +my $i=0; +my $argc=0; +while($ARGV[$argc]) { $argc++; } + +while($ARGV[$i]) { + + # suppress blank lines in header files + if($ARGV[$i] eq "-b") { + $blanksuppopt = 1; + } + + # read from stdin instead of file + elsif($ARGV[$i] eq "-c") { + AddInputFile("-"); + } + + # Defines: -Dmacro[=defn] or -D macro[=defn] + elsif(substr($ARGV[$i], 0, 2) eq "-D") { + my $macrodefn; + # -D macro[=defn] format + if(length($ARGV[$i]) == 2) { + if($i+1 >= $argc) { + Error("Argument to `-D' is missing"); + } + $macrodefn = $ARGV[++$i]; + } + # -Dmacro[=defn] format + else { + $macrodefn = substr($ARGV[$i], 2); + } + my $macro = $macrodefn; + my $defn = ""; + my $j = index($macrodefn, "="); + if($j > -1) { + $defn = substr($macrodefn, $j+1); + $macro = substr($macrodefn, 0, $j); + } + # add macro and defn to hash table + Define($macro." ".$defn); + } + + # Debugging turned on: -d + elsif($ARGV[$i] eq "-d") { + SetDebug(2); + } + + # Full debugging turned on: -dd + elsif($ARGV[$i] eq "-dd") { + SetDebug(3); + } + + # Light debugging turned on: -dl + elsif($ARGV[$i] eq "-dl") { + SetDebug(1); + } + + # Send debugging info to stdout rather than stderr + elsif($ARGV[$i] eq "-ds") { + $debugstdout = 1; + } + + # prefix all debugging info with string + elsif($ARGV[$i] eq "-dpre") { + if($i+1 >= $argc) { + Error("Argument to `-dpre' is missing"); + } + $debugprefix = ReplaceDefines($ARGV[++$i]); + } + + # prefix all debugging info with string + elsif($ARGV[$i] eq "-dpost") { + if($i+1 >= $argc) { + Error("Argument to `-dpost' is missing"); + } + # replace defines is called here in case a newline is required, + # this allows it to be added as __NEWLINE__ + $debugpostfix = ReplaceDefines($ARGV[++$i]); + } + + # define environment variables as macros: -e + elsif($ARGV[$i] eq "-e") { + DefineEnv(); + } + + # set environment variable prefix char + elsif($ARGV[$i] eq "-ec") { + if($i+1 >= $argc) { + Error("Argument to `-ec' is missing"); + } + SetEnvchar($ARGV[++$i]); + } + + # set environment variable prefix char to nothing + elsif($ARGV[$i] eq "-ecn") { + SetEnvchar(""); + } + + # show help + elsif($ARGV[$i] eq "-h") { + print(STDERR $usage); + exit(0); + } + + # Include paths: -Iinclude or -I include + elsif(substr($ARGV[$i], 0, 2) eq "-I") { + # -I include format + if(length($ARGV[$i]) == 2) { + if($i+1 >= $argc) { + Error("Argument to `-I' is missing"); + } + AddIncludePath($ARGV[++$i]); + } + # -Iinclude format + else { + AddIncludePath(substr($ARGV[$i], 2)); + } + } + + # Include macros from file: -imacros file + elsif($ARGV[$i] eq "-imacros") { + if($i+1 >= $argc) { + Error("Argument to `-imacros' is missing"); + } + push(@Imacrofiles, $ARGV[++$i]); + } + + # turn off keywords + elsif($ARGV[$i] eq "-k") { + RemoveAllKeywords(); + } + + # set keyword prefix char + elsif($ARGV[$i] eq "-kc") { + if($i+1 >= $argc) { + Error("Argument to `-kc' is missing"); + } + SetKeywordchar($ARGV[++$i]); + } + + # set line continuation character + elsif($ARGV[$i] eq "-lc") { + if($i+1 >= $argc) { + Error("Argument to `-lc' is missing"); + } + SetContchar($ARGV[++$i]); + } + + # set optional line end character + elsif($ARGV[$i] eq "-lec") { + if($i+1 >= $argc) { + Error("Argument to `-lec' is missing"); + } + SetOptLineEndchar($ARGV[++$i]); + } + + # set line continuation replacement char to newline + elsif($ARGV[$i] eq "-lrn") { + SetContrepchar("\n"); + } + + # set line continuation replacement character + elsif($ARGV[$i] eq "-lr") { + if($i+1 >= $argc) { + Error("Argument to `-lr' is missing"); + } + SetContrepchar($ARGV[++$i]); + } + + # Module paths: -Minclude or -M include + elsif(substr($ARGV[$i], 0, 2) eq "-M") { + # -M include format + if(length($ARGV[$i]) == 2) { + if($i+1 >= $argc) { + Error("Argument to `-M' is missing"); + } + AddModulePath($ARGV[++$i]); + } + # -Minclude format + else { + AddModulePath(substr($ARGV[$i], 2)); + } + } + + # use module + elsif($ARGV[$i] eq "-m") { + if($i+1 >= $argc) { + Error("Argument to `-m' is missing"); + } + UseModule($ARGV[++$i]); + } + + # set macro prefix + elsif($ARGV[$i] eq "-mp") { + if($i+1 >= $argc) { + Error("Argument to `-mp' is missing"); + } + SetMacroPrefix($ARGV[++$i]); + } + + # turn off macro prefix within keywords + elsif($ARGV[$i] eq "-mpnk") { + $macroprefixinkeywords = 0; + } + + # turn on overwrite mode + elsif($ARGV[$i] eq "-ov") { + $overwrite = 1; + } + + # turn on overwrite conversion mode + elsif($ARGV[$i] eq "-ovc") { + if($i+1 >= $argc) { + Error("Argument to `-ovc' is missing"); + } + $overwriteconv = $ARGV[++$i]; + if($overwriteconv !~ /=/) { + Error("-ovc argument is of form IN=OUT"); + } + $overwrite = 1; + } + + # Output filename: -o filename or -ofilename + elsif(substr($ARGV[$i], 0, 2) eq "-o") { + # -o filename + if(length($ARGV[$i]) == 2) { + if($i+1 >= $argc) { + Error("Argument to `-o' is missing"); + } + $outputfile = $ARGV[++$i]; + } + # -ofilename + else { + $outputfile = substr($ARGV[$i], 2); + } + } + + # preserve blank lines in output file + elsif($ARGV[$i] eq "-pb") { + $preserveblank = 1; + } + + # treat $keywordchar, $contchar and $optlineendchar as regular expressions + elsif($ARGV[$i] eq "-re") { + if($charperlre) { SetCharPerlre(0); } + else { SetCharPerlre(1); } + } + + # Safe mode - turns off #pragma + elsif($ARGV[$i] eq "-s") { + SafeMode(); + } + + # Undefine all macros + elsif($ARGV[$i] eq "-u") { + UndefAll(); + } + + # print version number and exit + elsif($ARGV[$i] eq "-v") { + print(STDERR "filepp version ".$VERSION."\n"); + exit(0); + } + + # only replace macros if they appear as 'words' + elsif($ARGV[$i] eq "-w") { + if($bound eq '') { SetWordBoundaries(1); } + else { SetWordBoundaries(0); } + } + + # default - an input file name + else { + if(!FileExists($ARGV[$i])) { + Error("Input file \"".$ARGV[$i]."\" not readable"); + } + AddInputFile($ARGV[$i]); + } + + $i++; +} + +# check input files have been specified +if($#Inputfiles == -1) { + Error("No input files given"); +} + +# import macros from file if any +if($#Imacrofiles >= 0) { + my $file; + foreach $file (@Imacrofiles) { IncludeMacros($file); } +} + +# print initial defines if debugging +if($debug > 1) { PrintDefines(); } + +# open the output file +if(!$overwrite) { OpenOutputFile($outputfile); } + +# parse all input files in order given on command line +my $base_file = ""; +foreach $base_file (@Inputfiles) { + Redefine("__BASE_FILE__", $base_file); + # set open output file if in overwrite mode + if($overwrite) { + if($overwriteconv ne "") { # convert output filename if needed + my ($in,$out) = split(/=/, $overwriteconv, 2); + my $outfile = $base_file; + $outfile =~ s/\Q$in\E/$out/; + OpenOutputFile($outfile); + } + else { OpenOutputFile($base_file); } + } + Parse($base_file); + # close output file if in overwrite mode + if($overwrite) { CloseOutputFile(); } +} + +# close output file +if(!$overwrite) { CloseOutputFile(); } + +exit(0); + +# Hey emacs !! +# Local Variables: +# mode: perl +# End: + +######################################################################## +# End of file +########################################################################