[p5sagit/p5-mst-13.2.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!
#!$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 ############
.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	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	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!
	24	#!$bin/perl
	25	'di';
	26	'ig00';
	27
55204971	28	\$perlincl = '$installprivlib';
154e51a4	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
fe14fcc3	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
55204971	44	@isatype{@isatype} = (1) x @isatype;
fe14fcc3	45
fe14fcc3	46	@ARGV = ('-') unless @ARGV;
154e51a4	47
154e51a4	48	foreach $file (@ARGV) {
fe14fcc3	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	}
154e51a4	61	}
fe14fcc3	62	open(IN,"$file") \|\| ((warn "Can't open $file: $!\n"),next);
fe14fcc3	63	open(OUT,">$perlincl/$outfile") \|\| die "Can't create $outfile: $!\n";
154e51a4	64	}
154e51a4	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)) {
55204971	90	$arg =~ s/^\s([^\s].[^\s])\s*$/$1/;
154e51a4	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	}
55204971	122	elsif (/^include\s+<(.*)>/) {
d9d8d8de	123	($incl = $1) =~ s/\.h$/.ph/;
d9d8d8de	124	print OUT $t,"require '$incl';\n";
154e51a4	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	};
154e51a4	184	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
	185	$new .= '$sizeof';
	186	next;
	187	};
	188	s/^([_a-zA-Z]\w*)// && do {
	189	$id = $1;
fe14fcc3	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	}
154e51a4	200	if ($curargs{$id}) {
	201	$new .= '$' . $id;
	202	}
	203	elsif ($id eq 'defined') {
	204	$new .= 'defined';
	205	}
	206	elsif (/^\(/) {
e5d73d77	207	s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
154e51a4	208	$new .= " &$id";
	209	}
	210	elsif ($isatype{$id}) {
fe14fcc3	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	}
154e51a4	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 ############
	240	.TH H2PH 1 "August 8, 1990"
	241	.AT 3
	242	.SH NAME
	243	h2ph \- convert .h C header files to .ph Perl header files
	244	.SH SYNOPSIS
	245	.B h2ph [headerfiles]
	246	.SH DESCRIPTION
	247	.I h2ph
	248	converts any C header files specified to the corresponding Perl header file
	249	format.
	250	It is most easily run while in /usr/include:
	251	.nf
	252
	253	cd /usr/include; h2ph * sys/*
	254
	255	.fi
fe14fcc3	256	If run with no arguments, filters standard input to standard output.
154e51a4	257	.SH ENVIRONMENT
	258	No environment variables are used.
	259	.SH FILES
	260	/usr/include/*.h
	261	.br
	262	/usr/include/sys/*.h
	263	.br
	264	etc.
	265	.SH AUTHOR
	266	Larry Wall
	267	.SH "SEE ALSO"
	268	perl(1)
	269	.SH DIAGNOSTICS
	270	The usual warnings if it can't read or write the files involved.
	271	.SH BUGS
	272	Doesn't construct the %sizeof array for you.
	273	.PP
	274	It doesn't handle all C constructs, but it does attempt to isolate
	275	definitions inside evals so that you can get at the definitions
	276	that it can translate.
	277	.PP
	278	It's only intended as a rough tool.
	279	You may need to dicker with the files produced.
	280	.ex
	281	!NO!SUBS!
	282	chmod 755 h2ph
	283	$eunicefix h2ph
	284	rm -f h2ph.man
	285	ln h2ph h2ph.man