summaryrefslogtreecommitdiff
path: root/source4/pidl/lib/Parse/Pidl
diff options
context:
space:
mode:
authorJelmer Vernooij <jelmer@samba.org>2005-10-04 17:21:31 +0000
committerGerald (Jerry) Carter <jerry@samba.org>2007-10-10 13:39:23 -0500
commit81c306472a9c6bf6238e916e49076525d4920ed8 (patch)
tree84b7bdadea99d6136ed73e7fcca1a4b779e7eba4 /source4/pidl/lib/Parse/Pidl
parent55065d27cede4e2cdc0e1240b1b5952fa5697391 (diff)
downloadsamba-81c306472a9c6bf6238e916e49076525d4920ed8.tar.gz
samba-81c306472a9c6bf6238e916e49076525d4920ed8.tar.bz2
samba-81c306472a9c6bf6238e916e49076525d4920ed8.zip
r10715: More Samba3 parser generator improvements:
- Actually generate parsers for unions and structs. - Support some more builtin types. - Some more work on supporting arrays. - Several other small fixes. I've updated the example output at http://samba.org/~jelmer/ (This used to be commit b229c033ebc7ec972b32f1b75b60a9c68a36db97)
Diffstat (limited to 'source4/pidl/lib/Parse/Pidl')
-rw-r--r--source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm37
-rw-r--r--source4/pidl/lib/Parse/Pidl/Samba3/Types.pm97
2 files changed, 104 insertions, 30 deletions
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
index 5caab5da0c..57ee1543ff 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm
@@ -23,8 +23,7 @@ sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
#TODO:
# - Different scalars / buffers functions for arrays + unions
-# - Register own types with Types::AddType()
-# - Find external types somehow?
+# - Memory allocation for arrays?
sub DeclareArrayVariables($)
{
@@ -78,7 +77,7 @@ sub ParseElementLevelPtr($$$$$)
fatal($e, "relative pointers not supported for Samba 3");
}
- pidl "if (!prs_uint32(\"ptr_$e->{NAME}\",ps,depth,&" . ParseExpr("ptr_$e->{NAME}", $env) . ", ps, depth))";
+ pidl "if (!prs_uint32(\"ptr_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr_$e->{NAME}", $env) . ", ps, depth))";
pidl "\treturn False;";
pidl "";
@@ -138,7 +137,7 @@ sub InitLevel($$$$)
deindent;
pidl "}";
} elsif ($l->{TYPE} eq "DATA") {
- pidl InitType($e, $l, $varname, $varname);
+ pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
} elsif ($l->{TYPE} eq "SWITCH") {
InitLevel($e, GetNextLevel($e,$l), $varname, $env);
}
@@ -149,20 +148,22 @@ sub CreateStruct($$$$)
my ($fn,$s,$es,$a) = @_;
my $args = "";
- foreach my $e (@$es) {
+ foreach (@$es) {
$args .= ", " . DeclLong($_);
}
- my $env = {};
+ my $env = { "this" => "v" };
foreach my $e (@$es) {
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "DATA") {
- $env->{"$e->{NAME}"} = $e->{"v->$e->{NAME}"};
+ $env->{$e->{NAME}} = "v->$e->{NAME}";
} elsif ($l->{TYPE} eq "POINTER") {
- $env->{"ptr_$e->{NAME}"} = $e->{"v->ptr_$e->{NAME}"};
+ $env->{"ptr_$e->{NAME}"} = "v->ptr_$e->{NAME}";
} elsif ($l->{TYPE} eq "SWITCH") {
- $env->{"level_$e->{NAME}"} = $e->{"v->level_$e->{NAME}"};
- }
+ $env->{"level_$e->{NAME}"} = "v->level_$e->{NAME}";
+ } elsif ($l->{TYPE} eq "ARRAY") {
+ $env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
+ }
}
}
@@ -173,7 +174,7 @@ sub CreateStruct($$$$)
pidl "";
# Call init for all arguments
foreach (@$es) {
- InitLevel($_, $_->{LEVELS}[0], ParseExpr($_->{NAME}, $env), $env);
+ InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
pidl "";
}
pidl "return True;";
@@ -238,11 +239,13 @@ sub ParseUnion($$$)
foreach (@{$u->{ELEMENTS}}) {
pidl "$_->{CASE}:";
indent;
- pidl "depth++;";
- ParseElement($_, {});
+ if ($_->{TYPE} ne "EMPTY") {
+ pidl "depth++;";
+ ParseElement($_, {});
+ pidl "depth--;";
+ }
+ pidl "break;";
deindent;
- pidl "depth--;";
- pidl "break";
pidl "";
}
@@ -290,8 +293,8 @@ sub ParseInterface($)
# Structures first
pidl "/* $if->{NAME} structures */";
foreach (@{$if->{TYPEDEFS}}) {
- ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "STRUCT");
- ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "UNION");
+ ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
+ ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
}
pidl "/* $if->{NAME} functions */";
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
index 68bea0d024..b9d969216c 100644
--- a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
+++ b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm
@@ -1,5 +1,5 @@
###################################################
-# Samba3 common helper functions
+# Samba3 type-specific declarations / initialization / marshalling
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
@@ -16,6 +16,10 @@ use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
use vars qw($VERSION);
$VERSION = '0.01';
+# TODO: Find external types somehow?
+
+sub warning($$) { my ($e,$s) = @_; print STDERR "$e->{FILE}:$e->{LINE}: $s\n"; }
+
sub init_scalar($$$$)
{
my ($e,$l,$n,$v) = @_;
@@ -36,6 +40,8 @@ sub decl_string($)
{
my $e = shift;
+ # FIXME: More intelligent code here - select between UNISTR2 and other
+ # variants
return "UNISTR2";
}
@@ -50,40 +56,67 @@ sub dissect_string($$$)
{
my ($e,$l,$n) = @_;
- return "FIXME";
+ return "prs_unistr2(True, \"$e->{NAME}\", ps, depth, &n)";
+}
+
+sub init_uuid($$$$)
+{
+ my ($e,$l,$n,$v) = @_;
+
+ return "";
+}
+
+sub dissect_uuid($$$)
+{
+ my ($e,$l,$n) = @_;
+
+ return "smb_io_uuid(\"$e->{NAME}\", &$n, ps, depth)";
}
-my $known_types = {
- uint8 => {
+my $known_types =
+{
+ uint8 =>
+ {
DECL => "uint8",
INIT => \&init_scalar,
DISSECT => \&dissect_scalar,
},
- uint16 => {
+ uint16 =>
+ {
DECL => "uint16",
INIT => \&init_scalar,
DISSECT => \&dissect_scalar,
},
- uint32 => {
+ uint32 =>
+ {
DECL => "uint32",
INIT => \&init_scalar,
DISSECT => \&dissect_scalar,
},
- string => {
+ string =>
+ {
DECL => \&decl_string,
INIT => \&init_string,
DISSECT => \&dissect_string,
},
- NTSTATUS => {
+ NTSTATUS =>
+ {
DECL => "NTSTATUS",
INIT => \&init_scalar,
DISSECT => \&dissect_scalar,
},
- WERROR => {
+ WERROR =>
+ {
DECL => "WERROR",
INIT => \&init_scalar,
DISSECT => \&dissect_scalar,
},
+ GUID =>
+ {
+ DECL => "struct uuid",
+ INIT => \&init_uuid,
+ DISSECT => \&dissect_uuid,
+ }
};
sub AddType($$)
@@ -101,7 +134,10 @@ sub GetType($)
my $t = $known_types->{$e->{TYPE}};
- return undef if not $t;
+ if (not $t) {
+ warning($e, "Can't declare unknown type $e->{TYPE}");
+ return undef;
+ }
# DECL can be a function
if (ref($t->{DECL}) eq "CODE") {
@@ -131,7 +167,13 @@ sub DeclLong($)
return undef if not $t;
- return "$t $e->{NAME}";
+ my $ptrs = "";
+
+ foreach my $l (@{$e->{LEVELS}}) {
+ ($ptrs.="*") if ($l->{TYPE} eq "POINTER");
+ }
+
+ return "$t $ptrs$e->{NAME}";
}
sub InitType($$$$)
@@ -140,7 +182,10 @@ sub InitType($$$$)
my $t = $known_types->{$l->{DATA_TYPE}};
- return undef if not $t;
+ if (not $t) {
+ warning($e, "Don't know how to initialize type $l->{DATA_TYPE}");
+ return undef;
+ }
# INIT can be a function
if (ref($t->{INIT}) eq "CODE") {
@@ -156,7 +201,10 @@ sub DissectType($$$)
my $t = $known_types->{$l->{DATA_TYPE}};
- return undef if not $t;
+ if (not $t) {
+ warning($e, "Don't know how to dissect type $l->{DATA_TYPE}");
+ return undef;
+ }
# DISSECT can be a function
if (ref($t->{DISSECT}) eq "CODE") {
@@ -166,4 +214,27 @@ sub DissectType($$$)
}
}
+sub LoadTypes($)
+{
+ my $ndr = shift;
+ foreach my $if (@{$ndr}) {
+ next unless ($if->{TYPE} eq "INTERFACE");
+
+ foreach my $td (@{$if->{TYPEDEFS}}) {
+ AddType($td->{NAME}, {
+ DECL => uc("$if->{NAME}_$td->{NAME}"),
+ INIT => sub {
+ my ($e,$l,$n,$v) = @_;
+ return "init_$td->{NAME}(&$n/*FIXME:OTHER ARGS*/);";
+ },
+ DISSECT => sub {
+ my ($e,$l,$n) = @_;
+
+ return "$if->{NAME}_io_$td->{NAME}(\"$e->{NAME}\", &$n, ps, depth)";
+ }
+ });
+ }
+ }
+}
+
1;