perl 5.0 alpha 8

[p5sagit/p5-mst-13.2.git] / ext / xvarpp

#!/usr/bin/perl
# $Header$ 

$usage = "Usage: xvar [-a] [-c] typemap file.xv\n";
die $usage unless (@ARGV >= 2 && @ARGV <= 4);

SWITCH: while ($ARGV[0] =~ /^-/) {
    $flag = shift @ARGV;
    $aflag = 1, next SWITCH if $flag =~ /^-a$/;
    $cflag = 1, next SWITCH if $flag =~ /^-c$/;
    die $usage;
}

$typemap = shift @ARGV;
open(TYPEMAP, $typemap) || die "cannot open $typemap\n";
while (<TYPEMAP>) {
	next if /^\s*$/ || /^#/;
	chop;
	($typename, $kind) = split(/\t+/);
	$type_kind{$typename} = $kind;
}
close(TYPEMAP);

$uvfile = shift @ARGV;
open(F, $uvfile) || die "cannot open $uvfile\n";
#($uvoutfile = $uvfile) =~ s|^.*/([^/]*).us$|\1.c| ;
#print "uvoutfile is $uvoutfile\n";

#open(FOUT, ">$uvoutfile") || die "cannot open $uvoutfile\n";
#select(FOUT);

while (<F>) {
	last if ($Module, $foo, $Package, $foo1, $Prefix) =
		/^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(\w+))?/;
	print $_;
}
$Package .= "::" if defined $Package && $Package ne "";
print <<EOF;
static struct varinfo varinfo [] = {
EOF

while (<F>) {
	next if /^s*$/ || /^#/;
	if (/^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(\w+))?/) {
		$Module = $1;
		$foo = $2;
		$Package = $3;
		$foo1 = $4;
		$Prefix = $5;
		$Package .= "'" if defined $Package && $Package ne "";
		next;
	}
	chop;
	$func = undef;
	($var, $kind, $store, $read) = split(/\t+/);
	die "$kind not defined in typemap\n" if !defined($type_kind{$kind});
	$flags = "0";
	if ($store =~ /FUNC=(.*)/) {
		$flags .= "|VI_FUNC";
		$func = $1;
	} elsif ($store eq "VAR") {
		$flags .= "|VI_VARIABLE";
	} elsif ($store ne "VAL") {
		die "$var storage class not VAL, VAR or FUNC\n";
	}
	if ($read eq "READWRITE") {
		$flags .= "|VI_READWRITE";
	} elsif ($read ne "READONLY") {
		die "$var access class not READONLY or READWRITE\n";
	}
	SIZE: {
		$type_kind = $type_kind{$kind};
		$size = 0;
		do {$size = "sizeof(int)"; last SIZE; }
						if ($type_kind eq "T_INT");
		do {$size = "sizeof($kind)"; last SIZE; }
						if ($type_kind eq "T_ENUM");
		do {$size = "sizeof(unsigned int)"; last SIZE; }
						if ($type_kind eq "T_U_INT");
		do {$size = "sizeof(short)"; last SIZE; }
						if ($type_kind eq "T_SHORT");
		do {$size = "sizeof(unsigned short)"; last SIZE; }
						if ($type_kind eq "T_U_SHORT");
		do {$size = "sizeof(long)"; last SIZE; }
						if ($type_kind eq "T_LONG");
		do {$size = "sizeof(unsigned long)"; last SIZE; }
						if ($type_kind eq "T_U_LONG");
		do {$size = "sizeof(char)"; last SIZE; }
						if ($type_kind eq "T_CHAR");
		do {$size = "sizeof(unsigned char)"; last SIZE; }
						if ($type_kind eq "T_U_CHAR");
		do {$size = "0"; last SIZE; }
						if ($type_kind eq "T_STRING");
		do {$size = "sizeof(char *)"; last SIZE; }
						if ($type_kind eq "T_PTR");
		do {$size = "sizeof($kind)"; last SIZE; }
						if ($type_kind eq "T_OPAQUE");
	}
	($name = $var) =~ s/^$Prefix//;
	print "    { \"$Package$name\", $type_kind, $flags, $size, ";
	if ($store =~ /FUNC/) {
		print "(char *)$func, 0.0 },\n";
	} elsif ($store eq "VAR") {
		print "(char *)&$var, 0.0 },\n";
	} elsif ($type_kind eq "T_FLOAT" || $type_kind eq "T_DOUBLE") {
		print "0, $var },\n";
	} else {
		print "(char *)$var, 0.0 },\n";
	}
}
print <<EOF if $aflag;
};

static unsigned long varinfolen = sizeof(varinfo)/sizeof(*varinfo);

static int UV_val(int ix, SV *sv)
{
    return common_UV_val(varinfo, varinfolen, ix, sv);
}

static int UV_set(int ix, SV *sv)
{
    return common_UV_set(varinfo, varinfolen, ix, sv);
}
EOF
print <<EOF if !$aflag;
};

static unsigned long varinfolen = sizeof(varinfo)/sizeof(*varinfo);

static int UV_val(ix, sv)
int ix;
SV *sv;
{
    return common_UV_val(varinfo, varinfolen, ix, sv);
}

static int UV_set(ix, sv)
int ix;
SV *sv;
{
    return common_UV_set(varinfo, varinfolen, ix, sv);
}

EOF
print qq/extern "C"\n/ if $cflag;
print <<EOF;
void init_$Module()
{
    int		i;
    struct	ufuncs uf;
    
    uf.uf_set = UV_set;
    uf.uf_val = UV_val;
    for (i = 0; i < varinfolen; i++) {
	uf.uf_index = i;
	magicname(varinfo[i].vname, (char *)&uf, sizeof uf);
    }
}

EOF