[perl5.git] / 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!
#!$binexp/perl
'di ';
'ds 00 \"';
'ig 00 ';

\$perlincl = '$archlibexp';
!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;
$inif = 0;

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