1# Copyright (c) 2008, 2017, Oracle and/or its affiliates. All rights reserved. 2# 3# Redistribution and use in source and binary forms, with or without 4# modification, are permitted provided that the following conditions are met: 5# 6# * Redistributions of source code must retain the above copyright 7# notice, this list of conditions and the following disclaimer. 8# * Redistributions in binary form must reproduce the above copyright 9# notice, this list of conditions and the following disclaimer in 10# the documentation and/or other materials provided with the 11# distribution. 12# * Neither the name of the above-listed copyright holders nor the names 13# of its contributors may be used to endorse or promote products derived 14# from this software without specific prior written permission. 15# 16# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 17# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 18# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 19# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 20# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 21# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 22# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 23# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 24# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 25# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27# 28# ident "@(#)dheadgen.pl 1.4 07/06/24 SMI" 29 30# 31# DTrace Header Generator 32# ----------------------- 33# 34# This script is meant to mimic the output of dtrace(1M) with the -h 35# (headergen) flag on system that lack native support for DTrace. This script 36# is intended to be integrated into projects that use DTrace's static tracing 37# facilities (USDT), and invoked as part of the build process to have a 38# common build process on all target systems. To facilitate this, this script 39# is licensed under a BSD license. On system with native DTrace support, the 40# dtrace(1M) command will be invoked to create the full header file; on other 41# systems, this script will generated a stub header file. 42# 43# Normally, generated macros take the form PROVIDER_PROBENAME(). It may be 44# desirable to customize the output of this script and of dtrace(1M) to 45# tailor the precise macro name. To do this, edit the emit_dtrace() subroutine 46# to pattern match for the lines you want to customize. 47# 48 49use strict; 50 51my @lines; 52my @tokens = (); 53my $lineno = 0; 54my $newline = 1; 55my $eof = 0; 56my $infile; 57my $outfile; 58my $force = 0; 59 60sub emit_dtrace { 61 my ($line) = @_; 62 63 # 64 # Insert customization here. For example, if you want to change the 65 # name of the macros you may do something like this: 66 # 67 # $line =~ s/(\s)[A-Z]+_/\1TRACE_MOZILLA_/; 68 # 69 70 print $line; 71} 72 73# 74# The remaining code deals with parsing D provider definitions and emitting 75# the stub header file. There should be no need to edit this absent a bug. 76# 77 78# 79# Emit the two relevant macros for each probe in the given provider: 80# PROVIDER_PROBENAME(<args>) 81# PROVIDER_PROBENAME_ENABLED() (0) 82# 83sub emit_provider { 84 my ($provname, @probes) = @_; 85 86 $provname = uc($provname); 87 88 foreach my $probe (@probes) { 89 my $probename = uc($$probe{'name'}); 90 my $argc = $$probe{'argc'}; 91 my $line; 92 93 $probename =~ s/__/_/g; 94 95 $line = "#define\t${provname}_${probename}("; 96 for (my $i = 0; $i < $argc; $i++) { 97 $line .= ($i == 0 ? '' : ', '); 98 $line .= "arg$i"; 99 } 100 $line .= ")\n"; 101 emit_dtrace($line); 102 103 $line = "#define\t${provname}_${probename}_ENABLED() (0)\n"; 104 emit_dtrace($line); 105 } 106 107 emit_dtrace("\n"); 108} 109 110sub emit_prologue { 111 my ($filename) = @_; 112 113 $filename =~ s/.*\///g; 114 $filename = uc($filename); 115 $filename =~ s/\./_/g; 116 117 emit_dtrace <<"EOF"; 118/* 119 * Generated by dheadgen(1). 120 */ 121 122#ifndef\t_${filename} 123#define\t_${filename} 124 125#ifdef\t__cplusplus 126extern "C" { 127#endif 128 129EOF 130} 131 132sub emit_epilogue { 133 my ($filename) = @_; 134 135 $filename =~ s/.*\///g; 136 $filename = uc($filename); 137 $filename =~ s/\./_/g; 138 139 emit_dtrace <<"EOF"; 140#ifdef __cplusplus 141} 142#endif 143 144#endif /* _$filename */ 145EOF 146} 147 148# 149# Get the next token from the file keeping track of the line number. 150# 151sub get_token { 152 my ($eof_ok) = @_; 153 my $tok; 154 155 while (1) { 156 while (scalar(@tokens) == 0) { 157 if (scalar(@lines) == 0) { 158 $eof = 1; 159 return if ($eof_ok); 160 die "expected more data at line $lineno"; 161 } 162 163 $lineno++; 164 push(@tokens, split(/(\s+|\n|[(){},#;]|\/\*|\*\/)/, 165 shift(@lines))); 166 } 167 168 $tok = shift(@tokens); 169 next if ($tok eq ''); 170 next if ($tok =~ /^[ \t]+$/); 171 172 return ($tok); 173 } 174} 175 176# 177# Ignore newlines, comments and typedefs 178# 179sub next_token { 180 my ($eof_ok) = @_; 181 my $tok; 182 183 while (1) { 184 $tok = get_token($eof_ok); 185 return if ($eof_ok && $eof); 186 if ($tok eq "typedef" or $tok =~ /^#/) { 187 while (1) { 188 $tok = get_token(0); 189 last if ($tok eq "\n"); 190 } 191 next; 192 } elsif ($tok eq '/*') { 193 while (get_token(0) ne '*/') { 194 next; 195 } 196 next; 197 } elsif ($tok eq "\n") { 198 next; 199 } 200 201 last; 202 } 203 204 return ($tok); 205} 206 207sub expect_token { 208 my ($t) = @_; 209 my $tok; 210 211 while (($tok = next_token(0)) eq "\n") { 212 next; 213 } 214 215 die "expected '$t' at line $lineno rather than '$tok'" if ($t ne $tok); 216} 217 218sub get_args { 219 expect_token('('); 220 221 my $tok = next_token(0); 222 my @args = (); 223 224 return (@args) if ($tok eq ')'); 225 226 if ($tok eq 'void') { 227 expect_token(')'); 228 return (@args); 229 } 230 231 my $arg = $tok; 232 233 while (1) { 234 $tok = next_token(0); 235 if ($tok eq ',' || $tok eq ')') { 236 push(@args, $arg); 237 $arg = ''; 238 last if ($tok eq ')'); 239 } else { 240 $arg = "$arg $tok"; 241 } 242 } 243 244 return (@args); 245} 246 247sub usage { 248 die "usage: $0 [-f] <filename.d>\n"; 249} 250 251usage() if (scalar(@ARGV) < 1); 252if ($ARGV[0] eq '-f') { 253 usage() if (scalar(@ARGV < 2)); 254 $force = 1; 255 shift; 256} 257$infile = $ARGV[0]; 258usage() if ($infile !~ /(.+)\.d$/); 259 260# 261# If the system has native support for DTrace, we'll use that binary instead. 262# 263if (-x '/usr/sbin/dtrace' && !$force) { 264 open(DTRACE, "-| /usr/sbin/dtrace -C -h -s $infile -o /dev/stdout") 265 or die "can't invoke dtrace(1M)"; 266 267 while (<DTRACE>) { 268 emit_dtrace($_); 269 } 270 271 close(DTRACE); 272 273 exit(0); 274} 275 276emit_prologue($infile); 277 278open(D, "< $infile") or die "couldn't open $infile"; 279@lines = <D>; 280close(D); 281 282while (1) { 283 my $nl = 0; 284 my $tok = next_token(1); 285 last if $eof; 286 287 if ($newline && $tok eq '#') { 288 while (1) { 289 $tok = get_token(0); 290 291 last if ($tok eq "\n"); 292 } 293 $nl = 1; 294 } elsif ($tok eq "\n") { 295 $nl = 1; 296 } elsif ($tok eq 'provider') { 297 my $provname = next_token(0); 298 my @probes = (); 299 expect_token('{'); 300 301 while (1) { 302 $tok = next_token(0); 303 if ($tok eq 'probe') { 304 my $probename = next_token(0); 305 my @args = get_args(); 306 307 next while (next_token(0) ne ';'); 308 309 push(@probes, { 310 'name' => $probename, 311 'argc' => scalar(@args) 312 }); 313 314 } elsif ($tok eq '}') { 315 expect_token(';'); 316 317 emit_provider($provname, @probes); 318 319 last; 320 } 321 } 322 323 } else { 324 die "syntax error at line $lineno near '$tok'\n"; 325 } 326 327 $newline = $nl; 328} 329 330emit_epilogue($infile); 331 332exit(0); 333