[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.
$spitshell >h2ph <<!GROK!THIS!
#!$bin/perl
'di';
'ig00';

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