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