diff options
Diffstat (limited to 'pidl/lib/Parse/Pidl/Typelist.pm')
-rw-r--r-- | pidl/lib/Parse/Pidl/Typelist.pm | 388 |
1 files changed, 388 insertions, 0 deletions
diff --git a/pidl/lib/Parse/Pidl/Typelist.pm b/pidl/lib/Parse/Pidl/Typelist.pm new file mode 100644 index 0000000..31ea19e --- /dev/null +++ b/pidl/lib/Parse/Pidl/Typelist.pm @@ -0,0 +1,388 @@ +################################################### +# Samba4 parser generator for IDL structures +# Copyright jelmer@samba.org 2005 +# released under the GNU GPL + +package Parse::Pidl::Typelist; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT_OK = qw(hasType getType resolveType mapTypeName mapTypeSpecifier scalar_is_reference expandAlias + mapScalarType addType typeIs is_signed is_scalar enum_type_fn + bitmap_type_fn mapType typeHasBody is_fixed_size_scalar + is_string_type +); +use vars qw($VERSION); +$VERSION = '0.01'; + +use Parse::Pidl::Util qw(has_property); +use strict; +use warnings; + +my %types = (); + +my @reference_scalars = ( + "string", "string_array", "nbt_string", "dns_string", + "wrepl_nbt_name", "dnsp_name", "dnsp_string", + "ipv4address", "ipv6address", "u16string" +); + +my @non_fixed_size_scalars = ( + "string", "string_array", "nbt_string", "dns_string", + "wrepl_nbt_name", "dnsp_name", "dnsp_string", + "u16string" +); + +# a list of known scalar types +my %scalars = ( + "void" => "void", + "char" => "char", + "int8" => "int8_t", + "uint8" => "uint8_t", + "int16" => "int16_t", + "uint16" => "uint16_t", + "int1632" => "int16_t", + "uint1632" => "uint16_t", + "int32" => "int32_t", + "uint32" => "uint32_t", + "int3264" => "int32_t", + "uint3264" => "uint32_t", + "hyper" => "uint64_t", + "int64" => "int64_t", + "dlong" => "int64_t", + "udlong" => "uint64_t", + "udlongr" => "uint64_t", + "double" => "double", + "pointer" => "void*", + "DATA_BLOB" => "DATA_BLOB", + "string" => "const char *", + "u16string" => "const unsigned char *", + "string_array" => "const char **", + "time_t" => "time_t", + "uid_t" => "uid_t", + "gid_t" => "gid_t", + "NTTIME" => "NTTIME", + "NTTIME_1sec" => "NTTIME", + "NTTIME_hyper" => "NTTIME", + "WERROR" => "WERROR", + "HRESULT" => "HRESULT", + "NTSTATUS" => "NTSTATUS", + "COMRESULT" => "COMRESULT", + "dns_string" => "const char *", + "nbt_string" => "const char *", + "wrepl_nbt_name"=> "struct nbt_name *", + "ipv4address" => "const char *", + "ipv6address" => "const char *", + "dnsp_name" => "const char *", + "dnsp_string" => "const char *", + "libndr_flags" => "libndr_flags", + "ndr_flags_type"=> "ndr_flags_type", +); + +my %aliases = ( + "error_status_t" => "uint32", + "boolean8" => "uint8", + "boolean32" => "uint32", + "DWORD" => "uint32", + "uint" => "uint32", + "int" => "int32", + "WORD" => "uint16", + "char" => "uint8", + "long" => "int32", + "short" => "int16", + "HYPER_T" => "hyper", + "mode_t" => "uint32", +); + +my %format_specifiers = ( + "char" => "c", + "int8_t", => "\"PRId8\"", + "int16_t", => "\"PRId16\"", + "int32_t", => "\"PRId32\"", + "int64_t", => "\"PRId64\"", + "uint8_t", => "\"PRIu8\"", + "uint16_t", => "\"PRIu16\"", + "uint32_t", => "\"PRIu32\"", + "uint64_t", => "\"PRIu64\"" +); + +sub expandAlias($) +{ + my $name = shift; + + return $aliases{$name} if defined($aliases{$name}); + + return $name; +} + +# map from a IDL type to a C header type +sub mapScalarType($) +{ + my $name = shift; + + # it's a bug when a type is not in the list + # of known scalars or has no mapping + return $scalars{$name} if defined($scalars{$name}); + + die("Unknown scalar type $name"); +} + +sub addType($) +{ + my $t = shift; + $types{$t->{NAME}} = $t; +} + +sub resolveType($) +{ + my ($ctype) = @_; + + if (not hasType($ctype)) { + # assume struct typedef + return { TYPE => "TYPEDEF", NAME => $ctype, DATA => { TYPE => "STRUCT" } }; + } else { + return getType($ctype); + } + + return $ctype; +} + +sub getType($) +{ + my $t = shift; + return ($t) if (ref($t) eq "HASH" and not defined($t->{NAME})); + return undef if not hasType($t); + return $types{$t->{NAME}} if (ref($t) eq "HASH"); + return $types{$t}; +} + +sub typeIs($$); +sub typeIs($$) +{ + my ($t,$tt) = @_; + + if (ref($t) eq "HASH") { + return 1 if ($t->{TYPE} eq "TYPEDEF" and $t->{DATA}->{TYPE} eq $tt); + return 1 if ($t->{TYPE} eq $tt); + return 0; + } + if (hasType($t) and getType($t)->{TYPE} eq "TYPEDEF") { + return typeIs(getType($t)->{DATA}, $tt); + } + return 0; +} + +sub hasType($) +{ + my $t = shift; + if (ref($t) eq "HASH") { + return 1 if (not defined($t->{NAME})); + return 1 if (defined($types{$t->{NAME}}) and + $types{$t->{NAME}}->{TYPE} eq $t->{TYPE}); + return 0; + } + return 1 if defined($types{$t}); + return 0; +} + +sub is_signed($) +{ + my $t = shift; + + return ($t eq "int8" + or $t eq "int16" + or $t eq "int32" + or $t eq "dlong" + or $t eq "int" + or $t eq "long" + or $t eq "short"); +} + +sub is_scalar($) +{ + sub is_scalar($); + my $type = shift; + + return 1 if (ref($type) eq "HASH" and + ($type->{TYPE} eq "SCALAR" or $type->{TYPE} eq "ENUM" or + $type->{TYPE} eq "BITMAP")); + + if (my $dt = getType($type)) { + return is_scalar($dt->{DATA}) if ($dt->{TYPE} eq "TYPEDEF"); + return 1 if ($dt->{TYPE} eq "SCALAR" or $dt->{TYPE} eq "ENUM" or + $dt->{TYPE} eq "BITMAP"); + } + + return 0; +} + +sub is_fixed_size_scalar($) +{ + my $name = shift; + + return 0 unless is_scalar($name); + return 0 if (grep(/^$name$/, @non_fixed_size_scalars)); + return 1; +} + +sub scalar_is_reference($) +{ + my $name = shift; + + return 1 if (grep(/^$name$/, @reference_scalars)); + return 0; +} + +sub is_string_type +{ + my ($t) = @_; + + return ($t eq "string" or $t eq "u16string"); +} + +sub RegisterScalars() +{ + foreach (keys %scalars) { + addType({ + NAME => $_, + TYPE => "TYPEDEF", + BASEFILE => "<builtin>", + DATA => { + TYPE => "SCALAR", + NAME => $_ + } + } + ); + } +} + +sub enum_type_fn($) +{ + my $enum = shift; + $enum->{TYPE} eq "ENUM" or die("not an enum"); + + # for typedef enum { } we need to check $enum->{PARENT} + if (has_property($enum, "enum8bit")) { + return "uint8"; + } elsif (has_property($enum, "enum16bit")) { + return "uint16"; + } elsif (has_property($enum, "v1_enum")) { + return "uint32"; + } elsif (has_property($enum->{PARENT}, "enum8bit")) { + return "uint8"; + } elsif (has_property($enum->{PARENT}, "enum16bit")) { + return "uint16"; + } elsif (has_property($enum->{PARENT}, "v1_enum")) { + return "uint32"; + } + return "uint1632"; +} + +sub bitmap_type_fn($) +{ + my $bitmap = shift; + + $bitmap->{TYPE} eq "BITMAP" or die("not a bitmap"); + + if (has_property($bitmap, "bitmap8bit")) { + return "uint8"; + } elsif (has_property($bitmap, "bitmap16bit")) { + return "uint16"; + } elsif (has_property($bitmap, "bitmap64bit")) { + return "hyper"; + } + return "uint32"; +} + +sub typeHasBody($) +{ + sub typeHasBody($); + my ($e) = @_; + + if ($e->{TYPE} eq "TYPEDEF") { + return 0 unless(defined($e->{DATA})); + return typeHasBody($e->{DATA}); + } + + return defined($e->{ELEMENTS}); +} + +sub mapType($$) +{ + sub mapType($$); + my ($t, $n) = @_; + + return mapType($t->{DATA}, $n) if ($t->{TYPE} eq "TYPEDEF"); + return mapScalarType($n) if ($t->{TYPE} eq "SCALAR"); + return "enum $n" if ($t->{TYPE} eq "ENUM"); + return "struct $n" if ($t->{TYPE} eq "STRUCT" or $t->{TYPE} eq "INTERFACE"); + return "union $n" if ($t->{TYPE} eq "UNION"); + return mapScalarType(bitmap_type_fn($t)) if ($t->{TYPE} eq "BITMAP"); + return "struct $n" if ($t->{TYPE} eq "PIPE"); + die("Unknown type $t->{TYPE}"); +} + +sub mapTypeName($) +{ + my $t = shift; + return "void" unless defined($t); + my $dt; + $t = expandAlias($t); + + if ($dt = getType($t)) { + return mapType($dt, $dt->{NAME}); + } elsif (ref($t) eq "HASH" and defined($t->{NAME})) { + return mapType($t, $t->{NAME}); + } else { + # Best guess + return "struct $t"; + } + +} + +sub mapTypeSpecifier($) +{ + my $t = shift; + return undef unless defined($t); + + return $format_specifiers{$t}; +} + +sub LoadIdl($;$) +{ + my $idl = shift; + my $basename = shift; + + foreach my $x (@{$idl}) { + next if $x->{TYPE} ne "INTERFACE"; + + # DCOM interfaces can be types as well + addType({ + NAME => $x->{NAME}, + TYPE => "TYPEDEF", + DATA => $x, + BASEFILE => $basename, + }) if (has_property($x, "object")); + + foreach my $y (@{$x->{DATA}}) { + if ($y->{TYPE} eq "TYPEDEF" + or $y->{TYPE} eq "UNION" + or $y->{TYPE} eq "STRUCT" + or $y->{TYPE} eq "ENUM" + or $y->{TYPE} eq "BITMAP" + or $y->{TYPE} eq "PIPE") { + $y->{BASEFILE} = $basename; + addType($y); + } + } + } +} + +sub GenerateTypeLib() +{ + return Parse::Pidl::Util::MyDumper(\%types); +} + +RegisterScalars(); + +1; |