From efc03df292aa84edb592c22191dbf86cdf8c32d0 Mon Sep 17 00:00:00 2001 From: Jelmer Vernooij Date: Sun, 21 Aug 2005 23:17:35 +0000 Subject: r9459: Move pidl up one level (to prevent too much nesting) (This used to be commit e48202275e60c18e464457d200daeb953386e221) --- source4/pidl/Parse/Pidl/Typelist.pm | 336 ++++++++++++++++++++++++++++++++++++ 1 file changed, 336 insertions(+) create mode 100644 source4/pidl/Parse/Pidl/Typelist.pm (limited to 'source4/pidl/Parse/Pidl/Typelist.pm') diff --git a/source4/pidl/Parse/Pidl/Typelist.pm b/source4/pidl/Parse/Pidl/Typelist.pm new file mode 100644 index 0000000000..10a4baf7e7 --- /dev/null +++ b/source4/pidl/Parse/Pidl/Typelist.pm @@ -0,0 +1,336 @@ +################################################### +# 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; -- cgit