diff options
Diffstat (limited to 'ext/xvarpp')
| -rwxr-xr-x | ext/xvarpp | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/ext/xvarpp b/ext/xvarpp new file mode 100755 index 0000000000..0d2c79af47 --- /dev/null +++ b/ext/xvarpp @@ -0,0 +1,161 @@ +#!/usr/bin/perl +# $Header$ + +$usage = "Usage: tuv [-a] [-c] typemap file.uv\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 |