diff options
Diffstat (limited to 'source4/build/pidl/Parse/Pidl/Typelist.pm')
-rw-r--r-- | source4/build/pidl/Parse/Pidl/Typelist.pm | 336 |
1 files changed, 0 insertions, 336 deletions
diff --git a/source4/build/pidl/Parse/Pidl/Typelist.pm b/source4/build/pidl/Parse/Pidl/Typelist.pm deleted file mode 100644 index 10a4baf7e7..0000000000 --- a/source4/build/pidl/Parse/Pidl/Typelist.pm +++ /dev/null @@ -1,336 +0,0 @@ -################################################### -# 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 = qw(hasType getType mapType); - -use Parse::Pidl::Util qw(has_property); -use strict; - -my %typedefs = (); - -# a list of known scalar types -my $scalars = { - # 0 byte types - "void" => { - C_TYPE => "void", - IS_REFERENCE => 0, - NDR_ALIGN => 0 - }, - - # 1 byte types - "char" => { - C_TYPE => "char", - IS_REFERENCE => 0, - NDR_ALIGN => 1 - }, - "int8" => { - C_TYPE => "int8_t", - IS_REFERENCE => 0, - NDR_ALIGN => 1 - }, - "uint8" => { - C_TYPE => "uint8_t", - IS_REFERENCE => 0, - NDR_ALIGN => 1 - }, - - # 2 byte types - "int16" => { - C_TYPE => "int16_t", - IS_REFERENCE => 0, - NDR_ALIGN => 2 - }, - "uint16" => { C_TYPE => "uint16_t", - IS_REFERENCE => 0, - NDR_ALIGN => 2 - }, - - # 4 byte types - "int32" => { - C_TYPE => "int32_t", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "uint32" => { C_TYPE => "uint32_t", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - - # 8 byte types - "hyper" => { - C_TYPE => "uint64_t", - IS_REFERENCE => 0, - NDR_ALIGN => 8 - }, - "dlong" => { - C_TYPE => "int64_t", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "udlong" => { - C_TYPE => "uint64_t", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "udlongr" => { - C_TYPE => "uint64_t", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - - # DATA_BLOB types - "DATA_BLOB" => { - C_TYPE => "DATA_BLOB", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - - # string types - "string" => { - C_TYPE => "const char *", - IS_REFERENCE => 1, - NDR_ALIGN => 4 #??? - }, - "string_array" => { - C_TYPE => "const char **", - IS_REFERENCE => 1, - NDR_ALIGN => 4 #??? - }, - - # time types - "time_t" => { - C_TYPE => "time_t", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "NTTIME" => { - C_TYPE => "NTTIME", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "NTTIME_1sec" => { - C_TYPE => "NTTIME", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "NTTIME_hyper" => { - C_TYPE => "NTTIME", - IS_REFERENCE => 0, - NDR_ALIGN => 8 - }, - - - # error code types - "WERROR" => { - C_TYPE => "WERROR", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "NTSTATUS" => { - C_TYPE => "NTSTATUS", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - "COMRESULT" => { - "C_TYPE" => "COMRESULT", - IS_REFERENCE => 0, - NDR_ALIGN => 4 - }, - - # special types - "nbt_string" => { - C_TYPE => "const char *", - IS_REFERENCE => 1, - NDR_ALIGN => 4 #??? - }, - "ipv4address" => { - C_TYPE => "const char *", - IS_REFERENCE => 1, - NDR_ALIGN => 4 - } -}; - -# 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 $typedefs{$name}->{DATA}->{C_TYPE} if defined($typedefs{$name}) and defined($typedefs{$name}->{DATA}->{C_TYPE}); - - die("Unknown scalar type $name"); -} - -sub getScalarAlignment($) -{ - 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}{NDR_ALIGN} if defined($scalars->{$name}) and defined($scalars->{$name}{NDR_ALIGN}); - - die("Unknown scalar type $name"); -} - -sub addType($) -{ - my $t = shift; - $typedefs{$t->{NAME}} = $t; -} - -sub getType($) -{ - my $t = shift; - return undef if not hasType($t); - return $typedefs{$t}; -} - -sub typeIs($$) -{ - my $t = shift; - my $tt = shift; - - return 1 if (hasType($t) and getType($t)->{DATA}->{TYPE} eq $tt); - return 0; -} - -sub hasType($) -{ - my $t = shift; - return 1 if defined($typedefs{$t}); - return 0; -} - -sub is_scalar($) -{ - my $type = shift; - - return 0 unless(hasType($type)); - - if (my $dt = getType($type)->{DATA}->{TYPE}) { - return 1 if ($dt eq "SCALAR" or $dt eq "ENUM" or $dt eq "BITMAP"); - } - - return 0; -} - -sub scalar_is_reference($) -{ - my $name = shift; - - return $scalars->{$name}{IS_REFERENCE} if defined($scalars->{$name}) and defined($scalars->{$name}{IS_REFERENCE}); - return 0; -} - -sub RegisterScalars() -{ - foreach my $k (keys %{$scalars}) { - $typedefs{$k} = { - NAME => $k, - TYPE => "TYPEDEF", - DATA => $scalars->{$k} - }; - $typedefs{$k}->{DATA}->{TYPE} = "SCALAR"; - $typedefs{$k}->{DATA}->{NAME} = $k; - } -} - -my $aliases = { - "DWORD" => "uint32", - "int" => "int32", - "WORD" => "uint16", - "char" => "uint8", - "long" => "int32", - "short" => "int16", - "HYPER_T" => "hyper", - "HRESULT" => "COMRESULT", -}; - -sub RegisterAliases() -{ - foreach my $k (keys %{$aliases}) { - $typedefs{$k} = $typedefs{$aliases->{$k}}; - } -} - -sub enum_type_fn($) -{ - my $enum = shift; - if (has_property($enum->{PARENT}, "enum8bit")) { - return "uint8"; - } elsif (has_property($enum->{PARENT}, "v1_enum")) { - return "uint32"; - } - return "uint16"; -} - -sub bitmap_type_fn($) -{ - my $bitmap = shift; - - if (has_property($bitmap, "bitmap8bit")) { - return "uint8"; - } elsif (has_property($bitmap, "bitmap16bit")) { - return "uint16"; - } elsif (has_property($bitmap, "bitmap64bit")) { - return "hyper"; - } - return "uint32"; -} - -sub mapType($) -{ - my $t = shift; - die("Undef passed to mapType") unless defined($t); - my $dt; - - unless ($dt or ($dt = getType($t))) { - # Best guess - return "struct $t"; - } - return mapScalarType($t) if ($dt->{DATA}->{TYPE} eq "SCALAR"); - return "enum $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "ENUM"); - return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "STRUCT"); - return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "INTERFACE"); - return "union $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "UNION"); - - if ($dt->{DATA}->{TYPE} eq "BITMAP") { - return mapScalarType(bitmap_type_fn($dt->{DATA})); - } - - die("Unknown type $dt->{DATA}->{TYPE}"); -} - -sub LoadIdl($) -{ - my $idl = 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 - }) if (has_property($x, "object")); - - foreach my $y (@{$x->{DATA}}) { - addType($y) if ( - $y->{TYPE} eq "TYPEDEF" - or $y->{TYPE} eq "DECLARE"); - } - } -} - -RegisterScalars(); -RegisterAliases(); - -1; |