r5672: Use switch_type() and the token storage mechanism for unions:
[samba.git] / source4 / 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 unless(defined($typedefs{$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 "uint64";
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      "uint64"       => "uint64_t",
101      "dlong"        => "int64_t",
102      "udlong"       => "uint64_t",
103      "udlongr"      => "uint64_t",
104      "hyper"        => "uint64_t",
105      "NTTIME_1sec"  => "NTTIME",
106      "NTTIME_hyper" => "NTTIME",
107      "ipv4address"  => "const char *"
108      );
109
110 # map from a IDL type to a C header type
111 sub mapScalarType($)
112 {
113         my $name = shift;
114         if (my $ret = $scalar_type_mappings{$name}) {
115                 return $ret;
116         }
117         return $name;
118 }
119
120 sub mapType($)
121 {
122         my $e = shift;
123         my $dt;
124
125         return "const char *" if ($e->{TYPE} =~ "string");
126
127         if ($e->{TYPE} eq "ENUM" or $e->{TYPE} eq "BITMAP") {
128                 $dt = getType($e->{PARENT}->{NAME});
129         }
130         
131         unless ($dt or $dt = getType($e->{TYPE})) {
132                 # Best guess
133                 return "struct $e->{TYPE}";
134         }
135         return mapScalarType($e->{TYPE}) if ($dt->{DATA}->{TYPE} eq "SCALAR");
136         return "enum $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "ENUM");
137         return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "STRUCT");
138         return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "INTERFACE");
139         return "union $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "UNION");
140         return mapScalarType(bitmap_type_fn($dt->{DATA})) if ($dt->{DATA}->{TYPE} eq "BITMAP");
141
142         die("Unknown type $dt->{DATA}->{TYPE}");
143 }
144
145 sub LoadIdl($)
146 {
147         my $idl = shift;
148
149         foreach my $x (@{$idl}) {
150                 next if $x->{TYPE} ne "INTERFACE";
151
152                 # DCOM interfaces can be types as well
153                 addType({
154                         NAME => $x->{NAME},
155                         TYPE => "TYPEDEF",
156                         DATA => $x
157                         }) if (util::has_property($x, "object"));
158
159                 foreach my $y (@{$x->{DATA}}) {
160                         addType($y) if (
161                                 $y->{TYPE} eq "TYPEDEF" 
162                          or $y->{TYPE} eq "DECLARE");
163                 }
164         }
165 }
166
167 RegisterPrimitives();
168
169
170 1;