source/build/pidl/typelist.pm

   1 ###################################################
   2 # Samba4 parser generator for IDL structures
   3 # Copyright jelmer@samba.org 2005
   4 # released under the GNU GPL
   5
   6 package typelist;
   7
   8 use strict;
   9
  10 my %typedefs = ();
  11
  12 sub addType($)
  13 {
  14         my $t = shift;
  15         $typedefs{$t->{NAME}} = $t;
  16 }
  17
  18 sub getType($)
  19 {
  20         my $t = shift;
  21         return undef if not hasType($t);
  22         return $typedefs{$t};
  23 }
  24
  25 sub typeIs($$)
  26 {
  27         my $t = shift;
  28         my $tt = shift;
  29
  30         return 1 if (hasType($t) and getType($t)->{DATA}->{TYPE} eq $tt);
  31         return 0;
  32 }
  33
  34 sub hasType($)
  35 {
  36         my $t = shift;
  37         return 1 if defined($typedefs{$t});
  38         return 0;
  39 }
  40
  41 sub RegisterPrimitives()
  42 {
  43         my @primitives = (
  44                 "char", "int8", "uint8", "short", "wchar_t",
  45                 "int16", "uint16", "long", "int32", "uint32",
  46                 "dlong", "udlong", "udlongr", "NTTIME", "NTTIME_1sec",
  47                 "time_t", "DATA_BLOB", "error_status_t", "WERROR",
  48                 "NTSTATUS", "boolean32", "unsigned32", "ipv4address",
  49                 "hyper", "NTTIME_hyper");
  50
  51         foreach my $k (@primitives) {
  52                 $typedefs{$k} = {
  53                         NAME => $k,
  54                         TYPE => "TYPEDEF",
  55                         DATA => {
  56                                 TYPE => "SCALAR",
  57                                 NAME => $k
  58                         }
  59                 };
  60         }
  61 }
  62
  63 sub enum_type_fn($)
  64 {
  65         my $enum = shift;
  66         if (util::has_property($enum->{PARENT}, "enum8bit")) {
  67                 return "uint8";
  68         } elsif (util::has_property($enum->{PARENT}, "v1_enum")) {
  69                 return "uint32";
  70         }
  71         return "uint16";
  72 }
  73
  74 sub bitmap_type_fn($)
  75 {
  76         my $bitmap = shift;
  77
  78         if (util::has_property($bitmap, "bitmap8bit")) {
  79                 return "uint8";
  80         } elsif (util::has_property($bitmap, "bitmap16bit")) {
  81                 return "uint16";
  82         } elsif (util::has_property($bitmap, "bitmap64bit")) {
  83                 return "hyper";
  84         }
  85         return "uint32";
  86 }
  87
  88 # provide mappings between IDL base types and types in our headers
  89 my %scalar_type_mappings =
  90     (
  91      "int8"         => "int8_t",
  92      "uint8"        => "uint8_t",
  93      "short"        => "int16_t",
  94      "wchar_t"      => "uint16_t",
  95      "int16"        => "int16_t",
  96      "uint16"       => "uint16_t",
  97      "int32"        => "int32_t",
  98      "uint32"       => "uint32_t",
  99      "int64"        => "int64_t",
 100      "dlong"        => "int64_t",
 101      "udlong"       => "uint64_t",
 102      "udlongr"      => "uint64_t",
 103      "hyper"        => "uint64_t",
 104      "NTTIME"       => "NTTIME",
 105      "NTTIME_1sec"  => "NTTIME",
 106      "time_t"       => "time_t",
 107      "NTTIME_hyper" => "NTTIME",
 108      "NTSTATUS"     => "NTSTATUS",
 109      "WERROR"       => "WERROR",
 110      "DATA_BLOB"    => "DATA_BLOB",
 111      "ipv4address"  => "const char *",
 112      "nbt_string"   => "const char *"
 113      );
 114
 115 # map from a IDL type to a C header type
 116 sub mapScalarType($)
 117 {
 118         my $name = shift;
 119         die("Undef passed to mapScalarType") unless defined($name);
 120         if (defined($scalar_type_mappings{$name})) {
 121                 return $scalar_type_mappings{$name};
 122         }
 123         die("Tried to map non-scalar type $name");
 124 }
 125
 126 sub mapType($)
 127 {
 128         my $t = shift;
 129         die("Undef passed to mapType") unless defined($t);
 130         my $dt;
 131
 132         return "void" if ($t eq "void");
 133         return "const char *" if ($t =~ "string");
 134
 135         unless ($dt or ($dt = getType($t))) {
 136                 # Best guess
 137                 return "struct $t";
 138         }
 139         return mapScalarType($t) if ($dt->{DATA}->{TYPE} eq "SCALAR");
 140         return "enum $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "ENUM");
 141         return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "STRUCT");
 142         return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "INTERFACE");
 143         return "union $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "UNION");
 144
 145         if ($dt->{DATA}->{TYPE} eq "BITMAP") {
 146                 return mapScalarType(bitmap_type_fn($dt->{DATA}));
 147         }
 148
 149         die("Unknown type $dt->{DATA}->{TYPE}");
 150 }
 151
 152 sub LoadIdl($)
 153 {
 154         my $idl = shift;
 155
 156         foreach my $x (@{$idl}) {
 157                 next if $x->{TYPE} ne "INTERFACE";
 158
 159                 # DCOM interfaces can be types as well
 160                 addType({
 161                         NAME => $x->{NAME},
 162                         TYPE => "TYPEDEF",
 163                         DATA => $x
 164                         }) if (util::has_property($x, "object"));
 165
 166                 foreach my $y (@{$x->{DATA}}) {
 167                         addType($y) if (
 168                                 $y->{TYPE} eq "TYPEDEF"
 169                              or $y->{TYPE} eq "DECLARE");
 170                 }
 171         }
 172 }
 173
 174 RegisterPrimitives();
 175
 176
 177 1;