diff --git a/src/backend/utils/Gen_dummy_probes.pl b/src/backend/utils/Gen_dummy_probes.pl new file mode 100644 index 0000000000..0499a4cbc9 --- /dev/null +++ b/src/backend/utils/Gen_dummy_probes.pl @@ -0,0 +1,249 @@ +#! /usr/bin/perl -w +#------------------------------------------------------------------------- +# +# Gen_dummy_probes.pl +# Perl script that generates probes.h file when dtrace is not available +# +# Portions Copyright (c) 2008-2016, PostgreSQL Global Development Group +# +# +# IDENTIFICATION +# src/backend/utils/Gen_dummy_probes.pl +# +# This program was generated by running perl's s2p over Gen_dummy_probes.sed +# +#------------------------------------------------------------------------- + +$0 =~ s/^.*?(\w+)[\.\w+]*$/$1/; + +use strict; +use Symbol; +use vars qw{ $isEOF $Hold %wFiles @Q $CondReg + $doAutoPrint $doOpenWrite $doPrint }; +$doAutoPrint = 1; +$doOpenWrite = 1; + +# prototypes +sub openARGV(); +sub getsARGV(;\$); +sub eofARGV(); +sub printQ(); + +# Run: the sed loop reading input and applying the script +# +sub Run() +{ + my ($h, $icnt, $s, $n); + + # hack (not unbreakable :-/) to avoid // matching an empty string + my $z = "\000"; + $z =~ /$z/; + + # Initialize. + openARGV(); + $Hold = ''; + $CondReg = 0; + $doPrint = $doAutoPrint; + CYCLE: + while (getsARGV()) + { + chomp(); + $CondReg = 0; # cleared on t + BOS:; + + # /^[ ]*probe /!d + unless (m /^[ \t]*probe /s) + { + $doPrint = 0; + goto EOS; + } + + # s/^[ ]*probe \([^(]*\)\(.*\);/\1\2/ + { + $s = s /^[ \t]*probe ([^(]*)(.*);/${1}${2}/s; + $CondReg ||= $s; + } + + # s/__/_/g + { + $s = s /__/_/sg; + $CondReg ||= $s; + } + + # y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/ + { y{abcdefghijklmnopqrstuvwxyz}{ABCDEFGHIJKLMNOPQRSTUVWXYZ}; } + + # s/^/#define TRACE_POSTGRESQL_/ + { + $s = s /^/#define TRACE_POSTGRESQL_/s; + $CondReg ||= $s; + } + + # s/([^,)]\{1,\})/(INT1)/ + { + $s = s /\([^,)]+\)/(INT1)/s; + $CondReg ||= $s; + } + + # s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/ + { + $s = s /\([^,)]+, [^,)]+\)/(INT1, INT2)/s; + $CondReg ||= $s; + } + + # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/ + { + $s = s /\([^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3)/s; + $CondReg ||= $s; + } + +# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/ + { + $s = +s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4)/s; + $CondReg ||= $s; + } + +# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/ + { + $s = +s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5)/s; + $CondReg ||= $s; + } + +# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/ + { + $s = +s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6)/s; + $CondReg ||= $s; + } + +# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/ + { + $s = +s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/s; + $CondReg ||= $s; + } + +# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/ + { + $s = +s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/s; + $CondReg ||= $s; + } + + # P + { + if (/^(.*)/) { print $1, "\n"; } + } + + # s/(.*$/_ENABLED() (0)/ + { + $s = s /\(.*$/_ENABLED() (0)/s; + $CondReg ||= $s; + } + EOS: if ($doPrint) + { + print $_, "\n"; + } + else + { + $doPrint = $doAutoPrint; + } + printQ() if @Q; + } + + exit(0); +} +Run(); + +# openARGV: open 1st input file +# +sub openARGV() +{ + unshift(@ARGV, '-') unless @ARGV; + my $file = shift(@ARGV); + open(ARG, "<$file") + || die("$0: can't open $file for reading ($!)\n"); + $isEOF = 0; +} + +# getsARGV: Read another input line into argument (default: $_). +# Move on to next input file, and reset EOF flag $isEOF. +sub getsARGV(;\$) +{ + my $argref = @_ ? shift() : \$_; + while ($isEOF || !defined($$argref = )) + { + close(ARG); + return 0 unless @ARGV; + my $file = shift(@ARGV); + open(ARG, "<$file") + || die("$0: can't open $file for reading ($!)\n"); + $isEOF = 0; + } + 1; +} + +# eofARGV: end-of-file test +# +sub eofARGV() +{ + return @ARGV == 0 && ($isEOF = eof(ARG)); +} + +# makeHandle: Generates another file handle for some file (given by its path) +# to be written due to a w command or an s command's w flag. +sub makeHandle($) +{ + my ($path) = @_; + my $handle; + if (!exists($wFiles{$path}) || $wFiles{$path} eq '') + { + $handle = $wFiles{$path} = gensym(); + if ($doOpenWrite) + { + if (!open($handle, ">$path")) + { + die("$0: can't open $path for writing: ($!)\n"); + } + } + } + else + { + $handle = $wFiles{$path}; + } + return $handle; +} + +# printQ: Print queued output which is either a string or a reference +# to a pathname. +sub printQ() +{ + for my $q (@Q) + { + if (ref($q)) + { + # flush open w files so that reading this file gets it all + if (exists($wFiles{$$q}) && $wFiles{$$q} ne '') + { + open($wFiles{$$q}, ">>$$q"); + } + + # copy file to stdout: slow, but safe + if (open(RF, "<$$q")) + { + while (defined(my $line = )) + { + print $line; + } + close(RF); + } + } + else + { + print $q; + } + } + undef(@Q); +} diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm index c5a43f9b12..60bcd7e7e6 100644 --- a/src/tools/msvc/Solution.pm +++ b/src/tools/msvc/Solution.pm @@ -313,7 +313,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY { print "Generating probes.h...\n"; system( -'psed -f src/backend/utils/Gen_dummy_probes.sed src/backend/utils/probes.d > src/include/utils/probes.h' +'perl src/backend/utils/Gen_dummy_probes.pl src/backend/utils/probes.d > src/include/utils/probes.h' ); }