summaryrefslogtreecommitdiff
path: root/source4/build/pidl/Parse/Pidl/Typelist.pm
diff options
context:
space:
mode:
Diffstat (limited to 'source4/build/pidl/Parse/Pidl/Typelist.pm')
-rw-r--r--source4/build/pidl/Parse/Pidl/Typelist.pm336
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;