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