[unix-history] / usr / src / contrib / perl-4.036 / h2ph.SH

case $CONFIG in
'')
    if test ! -f config.sh; then
	ln ../config.sh . || \
	ln ../../config.sh . || \
	ln ../../../config.sh . || \
	(echo "Can't find config.sh."; exit 1)
    fi 2>/dev/null
    . ./config.sh
    ;;
esac
: This forces SH files to create target in same directory as SH file.
: This is so that make depend always knows where to find SH derivatives.
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting h2ph (with variable substitutions)"
: This section of the file will have variable substitutions done on it.
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front.  You may delete these comments.
rm -f h2ph
$spitshell >h2ph <<!GROK!THIS!
#!$bin/perl
'di';
'ig00';

\$perlincl = '$installprivlib';
!GROK!THIS!

: In the following dollars and backticks do not need the extra backslash.
$spitshell >>h2ph <<'!NO!SUBS!'

chdir '/usr/include' || die "Can't cd /usr/include";

@isatype = split(' ',<<END);
	char	uchar	u_char
	short	ushort	u_short
	int	uint	u_int
	long	ulong	u_long
	FILE
END

@isatype{@isatype} = (1) x @isatype;

@ARGV = ('-') unless @ARGV;

foreach $file (@ARGV) {
    if ($file eq '-') {
	open(IN, "-");
	open(OUT, ">-");
    }
    else {
	($outfile = $file) =~ s/\.h$/.ph/ || next;
	print "$file -> $outfile\n";
	if ($file =~ m|^(.*)/|) {
	    $dir = $1;
	    if (!-d "$perlincl/$dir") {
		mkdir("$perlincl/$dir",0777);
	    }
	}
	open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
	open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
    }
    while (<IN>) {
	chop;
	while (/\\$/) {
	    chop;
	    $_ .= <IN>;
	    chop;
	}
	if (s:/\*:\200:g) {
	    s:\*/:\201:g;
	    s/\200[^\201]*\201//g;	# delete single line comments
	    if (s/\200.*//) {		# begin multi-line comment?
		$_ .= '/*';
		$_ .= <IN>;
		redo;
	    }
	}
	if (s/^#\s*//) {
	    if (s/^define\s+(\w+)//) {
		$name = $1;
		$new = '';
		s/\s+$//;
		if (s/^\(([\w,\s]*)\)//) {
		    $args = $1;
		    if ($args ne '') {
			foreach $arg (split(/,\s*/,$args)) {
			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
			    $curargs{$arg} = 1;
			}
			$args =~ s/\b(\w)/\$$1/g;
			$args = "local($args) = \@_;\n$t    ";
		    }
		    s/^\s+//;
		    do expr();
		    $new =~ s/(["\\])/\\$1/g;
		    if ($t ne '') {
			$new =~ s/(['\\])/\\$1/g;
			print OUT $t,
			  "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
		    }
		    else {
			print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
		    }
		    %curargs = ();
		}
		else {
		    s/^\s+//;
		    do expr();
		    $new = 1 if $new eq '';
		    if ($t ne '') {
			$new =~ s/(['\\])/\\$1/g;
			print OUT $t,"eval 'sub $name {",$new,";}';\n";
		    }
		    else {
			print OUT $t,"sub $name {",$new,";}\n";
		    }
		}
	    }
	    elsif (/^include\s+<(.*)>/) {
		($incl = $1) =~ s/\.h$/.ph/;
		print OUT $t,"require '$incl';\n";
	    }
	    elsif (/^ifdef\s+(\w+)/) {
		print OUT $t,"if (defined &$1) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (/^ifndef\s+(\w+)/) {
		print OUT $t,"if (!defined &$1) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (s/^if\s+//) {
		$new = '';
		do expr();
		print OUT $t,"if ($new) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (s/^elif\s+//) {
		$new = '';
		do expr();
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n${t}elsif ($new) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (/^else/) {
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n${t}else {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    }
	    elsif (/^endif/) {
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n";
	    }
	}
    }
    print OUT "1;\n";
}

sub expr {
    while ($_ ne '') {
	s/^(\s+)//		&& do {$new .= ' '; next;};
	s/^(0x[0-9a-fA-F]+)//	&& do {$new .= $1; next;};
	s/^(\d+)//		&& do {$new .= $1; next;};
	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
	s/^'((\\"|[^"])*)'//	&& do {
	    if ($curargs{$1}) {
		$new .= "ord('\$$1')";
	    }
	    else {
		$new .= "ord('$1')";
	    }
	    next;
	};
	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
	    $new .= '$sizeof';
	    next;
	};
	s/^([_a-zA-Z]\w*)//	&& do {
	    $id = $1;
	    if ($id eq 'struct') {
		s/^\s+(\w+)//;
		$id .= ' ' . $1;
		$isatype{$id} = 1;
	    }
	    elsif ($id eq 'unsigned') {
		s/^\s+(\w+)//;
		$id .= ' ' . $1;
		$isatype{$id} = 1;
	    }
	    if ($curargs{$id}) {
		$new .= '$' . $id;
	    }
	    elsif ($id eq 'defined') {
		$new .= 'defined';
	    }
	    elsif (/^\(/) {
		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
		$new .= " &$id";
	    }
	    elsif ($isatype{$id}) {
		if ($new =~ /{\s*$/) {
		    $new .= "'$id'";
		}
		elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
		    $new =~ s/\(\s*$//;
		    s/^[\s*]*\)//;
		}
		else {
		    $new .= $id;
		}
	    }
	    else {
		$new .= ' &' . $id;
	    }
	    next;
	};
	s/^(.)//			&& do {$new .= $1; next;};
    }
}
##############################################################################

	# These next few lines are legal in both Perl and nroff.

.00;			# finish .ig
 
'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
'; __END__ ############# From here on it's a standard manual page ############
!NO!SUBS!
cat << ENDOFMAN > h2ph.man
.TH H2PH 1 "August 8, 1990"
.AT 3
.SH NAME
h2ph \- convert .h C header files to .ph Perl header files
.SH SYNOPSIS
.B h2ph [headerfiles]
.SH DESCRIPTION
.I h2ph
converts any C header files specified to the corresponding Perl header file
format.
It is most easily run while in /usr/include:
.nf

	cd /usr/include; h2ph * sys/*

.fi
If run with no arguments, filters standard input to standard output.
.SH ENVIRONMENT
No environment variables are used.
.SH FILES
/usr/include/*.h
.br
/usr/include/sys/*.h
.br
etc.
.SH AUTHOR
Larry Wall
.SH "SEE ALSO"
perl(1)
.SH DIAGNOSTICS
The usual warnings if it can't read or write the files involved.
.SH BUGS
Doesn't construct the %sizeof array for you.
.PP
It doesn't handle all C constructs, but it does attempt to isolate
definitions inside evals so that you can get at the definitions
that it can translate.
.PP
It's only intended as a rough tool.
You may need to dicker with the files produced.
.ex
ENDOFMAN
chmod 755 h2ph
$eunicefix h2ph
Commit	Line	Data
269e65ba EA	1	case $CONFIG in
	2	'')
	3	if test ! -f config.sh; then
	4	ln ../config.sh . \|\| \
	5	ln ../../config.sh . \|\| \
	6	ln ../../../config.sh . \|\| \
	7	(echo "Can't find config.sh."; exit 1)
	8	fi 2>/dev/null
	9	. ./config.sh
	10	;;
	11	esac
	12	: This forces SH files to create target in same directory as SH file.
	13	: This is so that make depend always knows where to find SH derivatives.
	14	case "$0" in
	15	/) cd `expr X$0 : 'X\(.*\)/'` ;;
	16	esac
	17	echo "Extracting h2ph (with variable substitutions)"
	18	: This section of the file will have variable substitutions done on it.
	19	: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
	20	: Protect any dollar signs and backticks that you do not want interpreted
	21	: by putting a backslash in front. You may delete these comments.
	22	rm -f h2ph
	23	$spitshell >h2ph <<!GROK!THIS!
	24	#!$bin/perl
	25	'di';
	26	'ig00';
	27
	28	\$perlincl = '$installprivlib';
	29	!GROK!THIS!
	30
	31	: In the following dollars and backticks do not need the extra backslash.
	32	$spitshell >>h2ph <<'!NO!SUBS!'
	33
	34	chdir '/usr/include' \|\| die "Can't cd /usr/include";
	35
	36	@isatype = split(' ',<<END);
	37	char uchar u_char
	38	short ushort u_short
	39	int uint u_int
	40	long ulong u_long
	41	FILE
	42	END
	43
	44	@isatype{@isatype} = (1) x @isatype;
	45
	46	@ARGV = ('-') unless @ARGV;
	47
	48	foreach $file (@ARGV) {
	49	if ($file eq '-') {
	50	open(IN, "-");
	51	open(OUT, ">-");
	52	}
	53	else {
	54	($outfile = $file) =~ s/\.h$/.ph/ \|\| next;
	55	print "$file -> $outfile\n";
	56	if ($file =~ m\|^(.*)/\|) {
	57	$dir = $1;
	58	if (!-d "$perlincl/$dir") {
	59	mkdir("$perlincl/$dir",0777);
	60	}
	61	}
	62	open(IN,"$file") \|\| ((warn "Can't open $file: $!\n"),next);
	63	open(OUT,">$perlincl/$outfile") \|\| die "Can't create $outfile: $!\n";
	64	}
65	while (<IN>) {
66	chop;
67	while (/\\$/) {
68	chop;
69	$_ .= <IN>;
70	chop;
71	}
72	if (s:/\*:\200:g) {
73	s:\*/:\201:g;
74	s/\200[^\201]*\201//g; # delete single line comments
75	if (s/\200.*//) { # begin multi-line comment?
76	$_ .= '/*';
77	$_ .= <IN>;
78	redo;
79	}
80	}
81	if (s/^#\s*//) {
82	if (s/^define\s+(\w+)//) {
83	$name = $1;
84	$new = '';
85	s/\s+$//;
86	if (s/^\(([\w,\s]*)\)//) {
87	$args = $1;
88	if ($args ne '') {
89	foreach $arg (split(/,\s*/,$args)) {
90	$arg =~ s/^\s([^\s].[^\s])\s*$/$1/;
91	$curargs{$arg} = 1;
92	}
93	$args =~ s/\b(\w)/\$$1/g;
94	$args = "local($args) = \@_;\n$t ";
95	}
96	s/^\s+//;
97	do expr();
98	$new =~ s/(["\\])/\\$1/g;
99	if ($t ne '') {
100	$new =~ s/(['\\])/\\$1/g;
101	print OUT $t,
102	"eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
103	}
104	else {
105	print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
106	}
107	%curargs = ();
108	}
109	else {
110	s/^\s+//;
111	do expr();
112	$new = 1 if $new eq '';
113	if ($t ne '') {
114	$new =~ s/(['\\])/\\$1/g;
115	print OUT $t,"eval 'sub $name {",$new,";}';\n";
116	}
117	else {
118	print OUT $t,"sub $name {",$new,";}\n";
119	}
120	}
121	}
122	elsif (/^include\s+<(.*)>/) {
123	($incl = $1) =~ s/\.h$/.ph/;
124	print OUT $t,"require '$incl';\n";
125	}
126	elsif (/^ifdef\s+(\w+)/) {
127	print OUT $t,"if (defined &$1) {\n";
128	$tab += 4;
129	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
130	}
131	elsif (/^ifndef\s+(\w+)/) {
132	print OUT $t,"if (!defined &$1) {\n";
133	$tab += 4;
134	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
135	}
136	elsif (s/^if\s+//) {
137	$new = '';
138	do expr();
139	print OUT $t,"if ($new) {\n";
140	$tab += 4;
141	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
142	}
143	elsif (s/^elif\s+//) {
144	$new = '';
145	do expr();
146	$tab -= 4;
147	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
148	print OUT $t,"}\n${t}elsif ($new) {\n";
149	$tab += 4;
150	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
151	}
152	elsif (/^else/) {
153	$tab -= 4;
154	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
155	print OUT $t,"}\n${t}else {\n";
156	$tab += 4;
157	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
158	}
159	elsif (/^endif/) {
160	$tab -= 4;
161	$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
162	print OUT $t,"}\n";
163	}
164	}
165	}
166	print OUT "1;\n";
167	}
168
169	sub expr {
170	while ($_ ne '') {
171	s/^(\s+)// && do {$new .= ' '; next;};
172	s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
173	s/^(\d+)// && do {$new .= $1; next;};
174	s/^("(\\"\|[^"])*")// && do {$new .= $1; next;};
175	s/^'((\\"\|[^"])*)'// && do {
176	if ($curargs{$1}) {
177	$new .= "ord('\$$1')";
178	}
179	else {
180	$new .= "ord('$1')";
181	}
182	next;
183	};
184	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
185	$new .= '$sizeof';
186	next;
187	};
188	s/^([_a-zA-Z]\w*)// && do {
189	$id = $1;
190	if ($id eq 'struct') {
191	s/^\s+(\w+)//;
192	$id .= ' ' . $1;
193	$isatype{$id} = 1;
194	}
195	elsif ($id eq 'unsigned') {
196	s/^\s+(\w+)//;
197	$id .= ' ' . $1;
198	$isatype{$id} = 1;
199	}
200	if ($curargs{$id}) {
201	$new .= '$' . $id;
202	}
203	elsif ($id eq 'defined') {
204	$new .= 'defined';
205	}
206	elsif (/^\(/) {
207	s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
208	$new .= " &$id";
209	}
210	elsif ($isatype{$id}) {
211	if ($new =~ /{\s*$/) {
212	$new .= "'$id'";
213	}
214	elsif ($new =~ /\(\s$/ && /^[\s]*\)/) {
215	$new =~ s/\(\s*$//;
216	s/^[\s]\)//;
217	}
218	else {
219	$new .= $id;
220	}
221	}
222	else {
223	$new .= ' &' . $id;
224	}
225	next;
226	};
227	s/^(.)// && do {$new .= $1; next;};
228	}
229	}
230	##############################################################################
231
232	# These next few lines are legal in both Perl and nroff.
233
234	.00; # finish .ig
235
236	'di \" finish diversion--previous line must be blank
237	.nr nl 0-1 \" fake up transition to first page again
238	.nr % 0 \" start at page 1
239	'; __END__ ############# From here on it's a standard manual page ############
63d3368c EA	240	!NO!SUBS!
63d3368c EA	241	cat << ENDOFMAN > h2ph.man
269e65ba EA	242	.TH H2PH 1 "August 8, 1990"
	243	.AT 3
	244	.SH NAME
	245	h2ph \- convert .h C header files to .ph Perl header files
	246	.SH SYNOPSIS
	247	.B h2ph [headerfiles]
	248	.SH DESCRIPTION
	249	.I h2ph
	250	converts any C header files specified to the corresponding Perl header file
	251	format.
	252	It is most easily run while in /usr/include:
	253	.nf
	254
	255	cd /usr/include; h2ph * sys/*
	256
	257	.fi
	258	If run with no arguments, filters standard input to standard output.
	259	.SH ENVIRONMENT
	260	No environment variables are used.
	261	.SH FILES
	262	/usr/include/*.h
	263	.br
	264	/usr/include/sys/*.h
	265	.br
	266	etc.
	267	.SH AUTHOR
	268	Larry Wall
	269	.SH "SEE ALSO"
	270	perl(1)
	271	.SH DIAGNOSTICS
	272	The usual warnings if it can't read or write the files involved.
	273	.SH BUGS
	274	Doesn't construct the %sizeof array for you.
	275	.PP
	276	It doesn't handle all C constructs, but it does attempt to isolate
	277	definitions inside evals so that you can get at the definitions
	278	that it can translate.
	279	.PP
	280	It's only intended as a rough tool.
	281	You may need to dicker with the files produced.
	282	.ex
63d3368c	283	ENDOFMAN
269e65ba EA	284	chmod 755 h2ph
269e65ba EA	285	$eunicefix h2ph