Use the updated code generator with support for vtables & constructors.
Alexander Gavrilov
parent
16241a7e78
commit
d513e75365
@ -0,0 +1,6 @@
|
|||||||
|
#include "Internal.h"
|
||||||
|
#include "dfhack/DataDefs.h"
|
||||||
|
#include "dfhack/MiscUtils.h"
|
||||||
|
|
||||||
|
// Object constructors
|
||||||
|
#include "dfhack/df/static.ctors.inc"
|
||||||
@ -1,2 +1,3 @@
|
|||||||
*.h
|
*.h
|
||||||
*.inc
|
*.inc
|
||||||
|
*.xml
|
||||||
|
|||||||
@ -0,0 +1,50 @@
|
|||||||
|
package Bitfield;
|
||||||
|
|
||||||
|
use utf8;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use Exporter ();
|
||||||
|
our $VERSION = 1.00;
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw( &render_bitfield_core &render_bitfield_type );
|
||||||
|
our %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
|
||||||
|
our @EXPORT_OK = qw( );
|
||||||
|
}
|
||||||
|
|
||||||
|
END { }
|
||||||
|
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
|
use Common;
|
||||||
|
|
||||||
|
sub render_bitfield_core {
|
||||||
|
my ($name, $tag) = @_;
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
emit get_primitive_base($tag), ' whole;';
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
for my $item ($tag->findnodes('child::ld:field')) {
|
||||||
|
($item->getAttribute('ld:meta') eq 'number' &&
|
||||||
|
$item->getAttribute('ld:subtype') eq 'flag-bit')
|
||||||
|
or die "Invalid bitfield member: ".$item->toString."\n";
|
||||||
|
|
||||||
|
check_bad_attrs($item);
|
||||||
|
my $name = ensure_name $item->getAttribute('name');
|
||||||
|
my $size = $item->getAttribute('count') || 1;
|
||||||
|
emit "unsigned ", $name, " : ", $size, ";";
|
||||||
|
}
|
||||||
|
} "struct ", " bits;";
|
||||||
|
|
||||||
|
emit $name, '() : whole(0) {};';
|
||||||
|
} "union $name ", ";";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub render_bitfield_type {
|
||||||
|
my ($tag) = @_;
|
||||||
|
render_bitfield_core($typename,$tag);
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
@ -0,0 +1,262 @@
|
|||||||
|
package Common;
|
||||||
|
|
||||||
|
use utf8;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use Exporter ();
|
||||||
|
our $VERSION = 1.00;
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(
|
||||||
|
$main_namespace $export_prefix
|
||||||
|
%types %type_files *typename *filename
|
||||||
|
|
||||||
|
&parse_address &check_bad_attrs &check_name
|
||||||
|
&is_attr_true &type_header_def &add_type_to_hash
|
||||||
|
|
||||||
|
*lines *indentation &with_emit &emit &indent &outdent &emit_block
|
||||||
|
|
||||||
|
&is_primitive_type &primitive_type_name &get_primitive_base
|
||||||
|
|
||||||
|
*weak_refs *strong_refs ®ister_ref &decode_type_name_ref
|
||||||
|
|
||||||
|
%static_lines %static_includes &with_emit_static
|
||||||
|
|
||||||
|
&ensure_name &with_anon
|
||||||
|
);
|
||||||
|
our %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
|
||||||
|
our @EXPORT_OK = qw( );
|
||||||
|
}
|
||||||
|
|
||||||
|
END { }
|
||||||
|
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
|
our $main_namespace = '';
|
||||||
|
our $export_prefix = '';
|
||||||
|
|
||||||
|
our %types;
|
||||||
|
our %type_files;
|
||||||
|
|
||||||
|
# Misc XML analysis
|
||||||
|
|
||||||
|
our $typename;
|
||||||
|
our $filename;
|
||||||
|
|
||||||
|
sub parse_address($;$) {
|
||||||
|
my ($str,$in_bits) = @_;
|
||||||
|
return undef unless defined $str;
|
||||||
|
|
||||||
|
# Parse the format used by offset attributes in xml
|
||||||
|
$str =~ /^0x([0-9a-f]+)(?:\.([0-7]))?$/
|
||||||
|
or die "Invalid address syntax: $str\n";
|
||||||
|
my ($full, $bv) = ($1, $2);
|
||||||
|
die "Bits not allowed: $str\n" unless $in_bits;
|
||||||
|
return $in_bits ? (hex($full)*8 + ($bv||0)) : hex($full);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub check_bad_attrs($;$$) {
|
||||||
|
my ($tag, $allow_size, $allow_align) = @_;
|
||||||
|
|
||||||
|
die "Cannot use size, alignment or offset for ".$tag->nodeName."\n"
|
||||||
|
if ((!$allow_size && defined $tag->getAttribute('size')) ||
|
||||||
|
defined $tag->getAttribute('offset') ||
|
||||||
|
(!$allow_align && defined $tag->getAttribute('alignment')));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub check_name($) {
|
||||||
|
my ($name) = @_;
|
||||||
|
$name =~ /^[_a-zA-Z][_a-zA-Z0-9]*$/
|
||||||
|
or die "Invalid identifier: $name\n";
|
||||||
|
return $name;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub is_attr_true($$) {
|
||||||
|
my ($tag, $name) = @_;
|
||||||
|
return ($tag->getAttribute($name)||'') eq 'true';
|
||||||
|
}
|
||||||
|
|
||||||
|
sub type_header_def($) {
|
||||||
|
my ($name) = @_;
|
||||||
|
return uc($main_namespace).'_'.uc($name).'_H';
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_type_to_hash($) {
|
||||||
|
my ($type) = @_;
|
||||||
|
|
||||||
|
my $name = $type->getAttribute('type-name')
|
||||||
|
or die "Type without a name in $filename\n";
|
||||||
|
|
||||||
|
die "Duplicate definition of $name in $filename\n" if $types{$name};
|
||||||
|
|
||||||
|
local $typename = $name;
|
||||||
|
check_bad_attrs $type;
|
||||||
|
$types{$name} = $type;
|
||||||
|
$type_files{$name} = $filename;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Text generation with indentation
|
||||||
|
|
||||||
|
our @lines;
|
||||||
|
our $indentation = 0;
|
||||||
|
|
||||||
|
sub with_emit(&;$) {
|
||||||
|
# Executes the code block, and returns emitted lines
|
||||||
|
my ($blk, $start_indent) = @_;
|
||||||
|
local @lines;
|
||||||
|
local $indentation = ($start_indent||0);
|
||||||
|
$blk->();
|
||||||
|
return @lines;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub emit(@) {
|
||||||
|
# Emit an indented line to be returned from with_emit
|
||||||
|
my $line = join('',map { defined($_) ? $_ : '' } @_);
|
||||||
|
$line = (' 'x$indentation).$line unless length($line) == 0;
|
||||||
|
push @lines, $line;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub indent(&) {
|
||||||
|
# Indent lines emitted from the block by one step
|
||||||
|
my ($blk) = @_;
|
||||||
|
local $indentation = $indentation+2;
|
||||||
|
$blk->();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub outdent(&) {
|
||||||
|
# Unindent lines emitted from the block by one step
|
||||||
|
my ($blk) = @_;
|
||||||
|
local $indentation = ($indentation >= 2 ? $indentation-2 : 0);
|
||||||
|
$blk->();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub emit_block(&;$$%) {
|
||||||
|
# Emit a full {...} block with indentation
|
||||||
|
my ($blk, $prefix, $suffix, %flags) = @_;
|
||||||
|
my @inner = &with_emit($blk,$indentation+2);
|
||||||
|
return if $flags{-auto} && !@inner;
|
||||||
|
$prefix ||= '';
|
||||||
|
$suffix ||= '';
|
||||||
|
emit $prefix,'{';
|
||||||
|
push @lines, @inner;
|
||||||
|
emit '}',$suffix;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Primitive types
|
||||||
|
|
||||||
|
my @primitive_type_list =
|
||||||
|
qw(int8_t uint8_t int16_t uint16_t
|
||||||
|
int32_t uint32_t int64_t uint64_t
|
||||||
|
s-float
|
||||||
|
bool flag-bit
|
||||||
|
padding static-string);
|
||||||
|
|
||||||
|
my %primitive_aliases = (
|
||||||
|
's-float' => 'float',
|
||||||
|
'static-string' => 'char',
|
||||||
|
'flag-bit' => 'void',
|
||||||
|
'padding' => 'void',
|
||||||
|
);
|
||||||
|
|
||||||
|
my %primitive_types;
|
||||||
|
$primitive_types{$_}++ for @primitive_type_list;
|
||||||
|
|
||||||
|
sub is_primitive_type($) {
|
||||||
|
return $primitive_types{$_[0]};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub primitive_type_name($) {
|
||||||
|
my ($tag_name) = @_;
|
||||||
|
$primitive_types{$tag_name}
|
||||||
|
or die "Not primitive: $tag_name\n";
|
||||||
|
return $primitive_aliases{$tag_name} || $tag_name;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_primitive_base($;$) {
|
||||||
|
my ($tag, $default) = @_;
|
||||||
|
|
||||||
|
my $base = $tag->getAttribute('base-type') || $default || 'uint32_t';
|
||||||
|
$primitive_types{$base} or die "Must be primitive: $base\n";
|
||||||
|
|
||||||
|
return $base;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Type references
|
||||||
|
|
||||||
|
our %weak_refs;
|
||||||
|
our %strong_refs;
|
||||||
|
|
||||||
|
sub register_ref($;$) {
|
||||||
|
# Register a reference to another type.
|
||||||
|
# Strong ones require the type to be included.
|
||||||
|
my ($ref, $is_strong) = @_;
|
||||||
|
|
||||||
|
if ($ref) {
|
||||||
|
my $type = $types{$ref}
|
||||||
|
or die "Unknown type $ref referenced.\n";
|
||||||
|
|
||||||
|
if ($is_strong) {
|
||||||
|
$strong_refs{$ref}++;
|
||||||
|
} else {
|
||||||
|
$weak_refs{$ref}++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub decode_type_name_ref($;%) {
|
||||||
|
# Interpret the type-name field of a tag
|
||||||
|
my ($tag,%flags) = @_;
|
||||||
|
my $force_type = $flags{-force_type};
|
||||||
|
my $attr = $flags{-attr_name} || 'type-name';
|
||||||
|
my $tname = $tag->getAttribute($attr) or return undef;
|
||||||
|
|
||||||
|
if ($primitive_types{$tname}) {
|
||||||
|
die "Cannot use type $tname as $attr here: $tag\n"
|
||||||
|
if ($force_type && $force_type ne 'primitive');
|
||||||
|
return primitive_type_name($tname);
|
||||||
|
} else {
|
||||||
|
register_ref $tname, !$flags{-weak};
|
||||||
|
die "Cannot use type $tname as $attr here: $tag\n"
|
||||||
|
if ($force_type && $force_type ne $types{$tname}->getAttribute('ld:meta'));
|
||||||
|
return $main_namespace.'::'.$tname;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Static file output
|
||||||
|
|
||||||
|
our %static_lines;
|
||||||
|
our %static_includes;
|
||||||
|
|
||||||
|
sub with_emit_static(&;$) {
|
||||||
|
my ($blk, $tag) = @_;
|
||||||
|
my @inner = &with_emit($blk,2) or return;
|
||||||
|
$tag ||= '';
|
||||||
|
$static_includes{$tag}{$typename}++;
|
||||||
|
push @{$static_lines{$tag}}, @inner;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Anonymous variable names
|
||||||
|
|
||||||
|
our $anon_id = 0;
|
||||||
|
our $anon_prefix;
|
||||||
|
|
||||||
|
sub ensure_name($) {
|
||||||
|
# If the name is empty, assign an auto-generated one
|
||||||
|
my ($name) = @_;
|
||||||
|
unless ($name) {
|
||||||
|
$name = $anon_prefix.(($anon_id == 0) ? '' : '_'.$anon_id);
|
||||||
|
$anon_id++;
|
||||||
|
}
|
||||||
|
return check_name($name);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub with_anon(&;$) {
|
||||||
|
# Establish a new anonymous namespace
|
||||||
|
my ($blk,$stem) = @_;
|
||||||
|
local $anon_id = $stem ? 0 : 1;
|
||||||
|
local $anon_prefix = ($stem||'anon');
|
||||||
|
$blk->();
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
@ -0,0 +1,165 @@
|
|||||||
|
package Enum;
|
||||||
|
|
||||||
|
use utf8;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use Exporter ();
|
||||||
|
our $VERSION = 1.00;
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw( &render_enum_core &render_enum_type );
|
||||||
|
our %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
|
||||||
|
our @EXPORT_OK = qw( );
|
||||||
|
}
|
||||||
|
|
||||||
|
END { }
|
||||||
|
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
|
use Common;
|
||||||
|
|
||||||
|
sub render_enum_core($$) {
|
||||||
|
my ($name,$tag) = @_;
|
||||||
|
|
||||||
|
my $base = 0;
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
my @items = $tag->findnodes('child::enum-item');
|
||||||
|
my $idx = 0;
|
||||||
|
|
||||||
|
for my $item (@items) {
|
||||||
|
my $name = ensure_name $item->getAttribute('name');
|
||||||
|
my $value = $item->getAttribute('value');
|
||||||
|
|
||||||
|
$base = ($idx == 0) ? $value : undef if defined $value;
|
||||||
|
$idx++;
|
||||||
|
|
||||||
|
emit $name, (defined($value) ? ' = '.$value : ''), ',';
|
||||||
|
}
|
||||||
|
|
||||||
|
emit "_last_item_of_$name";
|
||||||
|
} "enum $name ", ";";
|
||||||
|
|
||||||
|
return $base;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub render_enum_tables($$$) {
|
||||||
|
my ($name,$tag,$base) = @_;
|
||||||
|
|
||||||
|
# Enumerate enum attributes
|
||||||
|
|
||||||
|
my %aidx = ('key' => 0);
|
||||||
|
my @anames = ('key');
|
||||||
|
my @avals = ('NULL');
|
||||||
|
my @atypes = ('const char*');
|
||||||
|
my @atnames = (undef);
|
||||||
|
my @aprefix = ('');
|
||||||
|
|
||||||
|
for my $attr ($tag->findnodes('child::enum-attr')) {
|
||||||
|
my $name = $attr->getAttribute('name') or die "Unnamed enum-attr.\n";
|
||||||
|
my $type = decode_type_name_ref $attr;
|
||||||
|
my $def = $attr->getAttribute('default-value');
|
||||||
|
|
||||||
|
my $base_tname = ($type && $type =~ /::(.*)$/ ? $1 : '');
|
||||||
|
$type = $base_tname if $base_tname eq $typename;
|
||||||
|
|
||||||
|
die "Duplicate attribute $name.\n" if exists $aidx{$name};
|
||||||
|
|
||||||
|
check_name $name;
|
||||||
|
$aidx{$name} = scalar @anames;
|
||||||
|
push @anames, $name;
|
||||||
|
push @atnames, $type;
|
||||||
|
|
||||||
|
if ($type) {
|
||||||
|
push @atypes, $type;
|
||||||
|
push @aprefix, ($base_tname ? $base_tname."::" : '');
|
||||||
|
push @avals, (defined $def ? $aprefix[-1].$def : "($type)0");
|
||||||
|
} else {
|
||||||
|
push @atypes, 'const char*';
|
||||||
|
push @avals, (defined $def ? "\"$def\"" : 'NULL');
|
||||||
|
push @aprefix, '';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Emit accessor function prototypes
|
||||||
|
|
||||||
|
emit "const $name _first_item_of_$name = ($name)$base;";
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
emit "return (value >= _first_item_of_$name && value < _last_item_of_$name);";
|
||||||
|
} "inline bool is_valid($name value) ";
|
||||||
|
|
||||||
|
for (my $i = 0; $i < @anames; $i++) {
|
||||||
|
emit "${export_prefix}$atypes[$i] get_$anames[$i]($name value);";
|
||||||
|
}
|
||||||
|
|
||||||
|
# Emit implementation
|
||||||
|
|
||||||
|
with_emit_static {
|
||||||
|
emit_block {
|
||||||
|
emit_block {
|
||||||
|
# Emit the entry type
|
||||||
|
emit_block {
|
||||||
|
for (my $i = 0; $i < @anames; $i++) {
|
||||||
|
emit "$atypes[$i] $anames[$i];";
|
||||||
|
}
|
||||||
|
} "struct _info_entry ", ";";
|
||||||
|
|
||||||
|
# Emit the info table
|
||||||
|
emit_block {
|
||||||
|
for my $item ($tag->findnodes('child::enum-item')) {
|
||||||
|
my $tag = $item->nodeName;
|
||||||
|
|
||||||
|
# Assemble item-specific attr values
|
||||||
|
my @evals = @avals;
|
||||||
|
my $name = $item->getAttribute('name');
|
||||||
|
$evals[0] = "\"$name\"" if $name;
|
||||||
|
|
||||||
|
for my $attr ($item->findnodes('child::item-attr')) {
|
||||||
|
my $name = $attr->getAttribute('name') or die "Unnamed item-attr.\n";
|
||||||
|
my $value = $attr->getAttribute('value') or die "No-value item-attr.\n";
|
||||||
|
my $idx = $aidx{$name} or die "Unknown item-attr: $name\n";
|
||||||
|
|
||||||
|
if ($atnames[$idx]) {
|
||||||
|
$evals[$idx] = $aprefix[$idx].$value;
|
||||||
|
} else {
|
||||||
|
$evals[$idx] = "\"$value\"";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
emit "{ ",join(', ',@evals)," },";
|
||||||
|
}
|
||||||
|
|
||||||
|
emit "{ ",join(', ',@avals)," }";
|
||||||
|
} "static const _info_entry _info[] = ", ";";
|
||||||
|
|
||||||
|
for (my $i = 0; $i < @anames; $i++) {
|
||||||
|
emit_block {
|
||||||
|
emit "return is_valid(value) ? _info[value - $base].$anames[$i] : $avals[$i];";
|
||||||
|
} "$atypes[$i] get_$anames[$i]($name value) ";
|
||||||
|
}
|
||||||
|
} "namespace $name ";
|
||||||
|
} "namespace enums ";
|
||||||
|
} 'enums';
|
||||||
|
}
|
||||||
|
|
||||||
|
sub render_enum_type {
|
||||||
|
my ($tag) = @_;
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
emit_block {
|
||||||
|
my $base = render_enum_core($typename,$tag);
|
||||||
|
|
||||||
|
if (defined $base) {
|
||||||
|
render_enum_tables($typename,$tag,$base);
|
||||||
|
} else {
|
||||||
|
print STDERR "Warning: complex enum: $typename\n";
|
||||||
|
}
|
||||||
|
} "namespace $typename ";
|
||||||
|
} "namespace enums ";
|
||||||
|
|
||||||
|
emit "using enums::",$typename,"::",$typename,";";
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
@ -0,0 +1,328 @@
|
|||||||
|
package StructFields;
|
||||||
|
|
||||||
|
use utf8;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use Exporter ();
|
||||||
|
our $VERSION = 1.00;
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(
|
||||||
|
*in_struct_body &with_struct_block
|
||||||
|
&get_struct_fields &get_struct_field_type
|
||||||
|
&emit_struct_fields
|
||||||
|
);
|
||||||
|
our %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
|
||||||
|
our @EXPORT_OK = qw( );
|
||||||
|
}
|
||||||
|
|
||||||
|
END { }
|
||||||
|
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
|
use Common;
|
||||||
|
use Enum;
|
||||||
|
use Bitfield;
|
||||||
|
|
||||||
|
# MISC
|
||||||
|
|
||||||
|
our $in_struct_body = 0;
|
||||||
|
|
||||||
|
sub with_struct_block(&$;$%) {
|
||||||
|
my ($blk, $tag, $name, %flags) = @_;
|
||||||
|
|
||||||
|
my $kwd = (is_attr_true($tag,'is-union') ? "union" : "struct");
|
||||||
|
my $exp = $flags{-export} ? $export_prefix : '';
|
||||||
|
my $prefix = $kwd.' '.$exp.($name ? $name.' ' : '');
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
local $_;
|
||||||
|
local $in_struct_body = 1;
|
||||||
|
if ($flags{-no_anon}) {
|
||||||
|
$blk->();
|
||||||
|
} else {
|
||||||
|
&with_anon($blk);
|
||||||
|
}
|
||||||
|
} $prefix, ";";
|
||||||
|
}
|
||||||
|
|
||||||
|
# FIELD TYPE
|
||||||
|
|
||||||
|
sub get_container_item_type($;%) {
|
||||||
|
my ($tag, %flags) = @_;
|
||||||
|
my @items = $tag->findnodes('ld:item');
|
||||||
|
if (@items) {
|
||||||
|
return get_struct_field_type($items[0], -local => 1, %flags);
|
||||||
|
} elsif ($flags{-void}) {
|
||||||
|
return $flags{-void};
|
||||||
|
} else {
|
||||||
|
die "Container without element: $tag\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my %atable = ( 1 => 'char', 2 => 'short', 4 => 'int' );
|
||||||
|
|
||||||
|
my %custom_primitive_handlers = (
|
||||||
|
'stl-string' => sub { return "std::string"; },
|
||||||
|
);
|
||||||
|
|
||||||
|
my %custom_container_handlers = (
|
||||||
|
'stl-vector' => sub {
|
||||||
|
my $item = get_container_item_type($_, -void => 'void*');
|
||||||
|
$item = 'char' if $item eq 'bool';
|
||||||
|
return "std::vector<$item>";
|
||||||
|
},
|
||||||
|
'stl-bit-vector' => sub {
|
||||||
|
return "std::vector<bool>";
|
||||||
|
},
|
||||||
|
'df-flagarray' => sub {
|
||||||
|
my $type = decode_type_name_ref($_, -attr_name => 'index-enum', -force_type => 'enum-type') || 'int';
|
||||||
|
return "BitArray<$type>";
|
||||||
|
},
|
||||||
|
);
|
||||||
|
|
||||||
|
sub emit_typedef($$) {
|
||||||
|
# Convert a prefix/postfix pair into a single name
|
||||||
|
my ($pre, $post) = @_;
|
||||||
|
my $name = ensure_name undef;
|
||||||
|
emit 'typedef ', $pre, ' ', $name, $post, ';';
|
||||||
|
return $name;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_struct_fields($) {
|
||||||
|
return $_[0]->findnodes('ld:field');
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_struct_field_type($;%) {
|
||||||
|
# Dispatch on the tag name, and retrieve the type prefix & suffix
|
||||||
|
my ($tag, %flags) = @_;
|
||||||
|
my $meta = $tag->getAttribute('ld:meta');
|
||||||
|
my $subtype = $tag->getAttribute('ld:subtype');
|
||||||
|
my $prefix;
|
||||||
|
my $suffix = '';
|
||||||
|
|
||||||
|
if ($prefix = $tag->getAttribute('ld:typedef-name')) {
|
||||||
|
unless ($flags{-local}) {
|
||||||
|
my @names = ( $main_namespace );
|
||||||
|
for my $parent ($tag->findnodes('ancestor::*')) {
|
||||||
|
if ($parent->nodeName eq 'ld:global-type') {
|
||||||
|
push @names, $parent->getAttribute('type-name');
|
||||||
|
} elsif (my $n = $parent->getAttribute('ld:typedef-name')) {
|
||||||
|
push @names, $n;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$prefix = join('::',@names,$prefix);
|
||||||
|
}
|
||||||
|
} elsif ($meta eq 'number') {
|
||||||
|
$prefix = primitive_type_name($subtype);
|
||||||
|
} elsif ($meta eq 'bytes') {
|
||||||
|
if ($flags{-local} && !$flags{-weak}) {
|
||||||
|
if ($subtype eq 'static-string') {
|
||||||
|
my $count = $tag->getAttribute('size') || 0;
|
||||||
|
$prefix = "char";
|
||||||
|
$suffix = "[$count]";
|
||||||
|
} elsif ($subtype eq 'padding') {
|
||||||
|
my $count = $tag->getAttribute('size') || 0;
|
||||||
|
my $alignment = $tag->getAttribute('alignment') || 1;
|
||||||
|
$prefix = $atable{$alignment} or die "Invalid alignment: $alignment\n";
|
||||||
|
($count % $alignment) == 0 or die "Invalid size & alignment: $count $alignment\n";
|
||||||
|
$suffix = "[".($count/$alignment)."]";
|
||||||
|
} else {
|
||||||
|
die "Invalid bytes subtype: $subtype\n";
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$prefix = primitive_type_name($subtype);
|
||||||
|
}
|
||||||
|
} elsif ($meta eq 'global') {
|
||||||
|
my $tname = $tag->getAttribute('type-name');
|
||||||
|
register_ref $tname, !$flags{-weak};
|
||||||
|
$prefix = $main_namespace.'::'.$tname;
|
||||||
|
} elsif ($meta eq 'compound') {
|
||||||
|
die "Unnamed compound in global mode: ".$tag->toString."\n" unless $flags{-local};
|
||||||
|
|
||||||
|
$prefix = ensure_name undef;
|
||||||
|
$tag->setAttribute('ld:typedef-name', $prefix) if $in_struct_body;
|
||||||
|
|
||||||
|
$subtype ||= 'compound';
|
||||||
|
if ($subtype eq 'enum') {
|
||||||
|
with_anon {
|
||||||
|
render_enum_core($prefix,$tag);
|
||||||
|
};
|
||||||
|
} elsif ($subtype eq 'bitfield') {
|
||||||
|
with_anon {
|
||||||
|
render_bitfield_core($prefix,$tag);
|
||||||
|
};
|
||||||
|
} else {
|
||||||
|
with_struct_block {
|
||||||
|
emit_struct_fields($tag, $prefix);
|
||||||
|
} $tag, $prefix;
|
||||||
|
}
|
||||||
|
} elsif ($meta eq 'pointer') {
|
||||||
|
$prefix = get_container_item_type($tag, -weak => 1, -void => 'void')."*";
|
||||||
|
} elsif ($meta eq 'static-array') {
|
||||||
|
($prefix, $suffix) = get_container_item_type($tag);
|
||||||
|
my $count = $tag->getAttribute('count') || 0;
|
||||||
|
$suffix = "[$count]".$suffix;
|
||||||
|
} elsif ($meta eq 'primitive') {
|
||||||
|
local $_ = $tag;
|
||||||
|
my $handler = $custom_primitive_handlers{$subtype} or die "Invalid primitive: $subtype\n";
|
||||||
|
$prefix = $handler->($tag, %flags);
|
||||||
|
} elsif ($meta eq 'container') {
|
||||||
|
local $_ = $tag;
|
||||||
|
my $handler = $custom_container_handlers{$subtype} or die "Invalid container: $subtype\n";
|
||||||
|
$prefix = $handler->($tag, %flags);
|
||||||
|
} elsif (!$flags{-local} && $tag->nodeName eq 'ld:global-type') {
|
||||||
|
my $tname = $tag->getAttribute('type-name');
|
||||||
|
$prefix = $main_namespace.'::'.$tname;
|
||||||
|
} else {
|
||||||
|
die "Invalid field meta type: $meta\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($subtype && $flags{-local} && $subtype eq 'enum') {
|
||||||
|
my $base = get_primitive_base($tag, 'int32_t');
|
||||||
|
$prefix = "enum_field<$prefix,$base>";
|
||||||
|
}
|
||||||
|
|
||||||
|
return ($prefix,$suffix) if wantarray;
|
||||||
|
if ($suffix) {
|
||||||
|
$prefix = emit_typedef($prefix, $suffix);
|
||||||
|
$tag->setAttribute('ld:typedef-name', $prefix) if $flags{-local} && $in_struct_body;
|
||||||
|
}
|
||||||
|
return $prefix;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub render_struct_field($) {
|
||||||
|
my ($tag) = @_;
|
||||||
|
|
||||||
|
# Special case: anonymous compounds.
|
||||||
|
if (is_attr_true($tag, 'ld:anon-compound'))
|
||||||
|
{
|
||||||
|
check_bad_attrs($tag);
|
||||||
|
with_struct_block {
|
||||||
|
render_struct_field($_) for get_struct_fields($tag);
|
||||||
|
} $tag, undef, -no_anon => 1;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Otherwise, create the name if necessary, and render
|
||||||
|
my $field_name = $tag->getAttribute('name');
|
||||||
|
my $name = ensure_name $field_name;
|
||||||
|
$tag->setAttribute('ld:anon-name', $name) unless $field_name;
|
||||||
|
with_anon {
|
||||||
|
my ($prefix, $postfix) = get_struct_field_type($tag, -local => 1);
|
||||||
|
emit $prefix, ' ', $name, $postfix, ';';
|
||||||
|
} "T_$name";
|
||||||
|
}
|
||||||
|
|
||||||
|
our @simple_inits;
|
||||||
|
our $in_union = 0;
|
||||||
|
|
||||||
|
sub render_field_init($$) {
|
||||||
|
my ($field, $prefix) = @_;
|
||||||
|
local $_;
|
||||||
|
|
||||||
|
my $meta = $field->getAttribute('ld:meta');
|
||||||
|
my $subtype = $field->getAttribute('ld:subtype');
|
||||||
|
my $name = $field->getAttribute('name') || $field->getAttribute('ld:anon-name');
|
||||||
|
my $fname = ($prefix && $name ? $prefix.'.'.$name : ($name||$prefix));
|
||||||
|
|
||||||
|
my $is_struct = $meta eq 'compound' && !$subtype;
|
||||||
|
my $is_union = ($is_struct && is_attr_true($field, 'is-union'));
|
||||||
|
local $in_union = $in_union || $is_union;
|
||||||
|
|
||||||
|
if (is_attr_true($field, 'ld:anon-compound') || ($in_union && $is_struct))
|
||||||
|
{
|
||||||
|
my @fields = $is_union ? $field->findnodes('ld:field[1]') : get_struct_fields($field);
|
||||||
|
&render_field_init($_, $fname) for @fields;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
return unless ($name || $prefix =~ /\]$/);
|
||||||
|
|
||||||
|
my $val = $field->getAttribute('init-value');
|
||||||
|
my $assign = 0;
|
||||||
|
|
||||||
|
if ($meta eq 'number' || $meta eq 'pointer') {
|
||||||
|
$assign = 1;
|
||||||
|
my $signed_ref =
|
||||||
|
!is_attr_true($field,'ld:unsigned') &&
|
||||||
|
($field->getAttribute('ref-target') || $field->getAttribute('refers-to'));
|
||||||
|
$val ||= ($signed_ref ? '-1' : 0);
|
||||||
|
} elsif ($meta eq 'bytes') {
|
||||||
|
emit "memset($fname, 0, sizeof($fname));";
|
||||||
|
} elsif ($meta eq 'global' || $meta eq 'compound') {
|
||||||
|
return unless $subtype;
|
||||||
|
|
||||||
|
if ($subtype eq 'bitfield' && $val) {
|
||||||
|
emit $fname, '.whole = ', $val;
|
||||||
|
} elsif ($subtype eq 'enum') {
|
||||||
|
$assign = 1;
|
||||||
|
if ($meta eq 'global') {
|
||||||
|
my $tname = $field->getAttribute('type-name');
|
||||||
|
$val = ($val ? $main_namespace.'::enums::'.$tname.'::'.$val : "ENUM_FIRST_ITEM($tname)");
|
||||||
|
} else {
|
||||||
|
$val ||= $field->findvalue('enum-item[1]/@name');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} elsif ($meta eq 'static-array') {
|
||||||
|
my $idx = ensure_name undef;
|
||||||
|
my $count = $field->getAttribute('count')||0;
|
||||||
|
emit_block {
|
||||||
|
my $pfix = $fname."[$idx]";
|
||||||
|
render_field_init($_, $pfix) for $field->findnodes('ld:item');
|
||||||
|
} "for (int $idx = 0; $idx < $count; $idx++) ", "", -auto => 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($assign) {
|
||||||
|
if ($prefix || $in_union) {
|
||||||
|
emit "$fname = $val;";
|
||||||
|
} else {
|
||||||
|
push @simple_inits, "$name($val)";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub emit_struct_fields($$;%) {
|
||||||
|
my ($tag, $name, %flags) = @_;
|
||||||
|
|
||||||
|
local $_;
|
||||||
|
my @fields = get_struct_fields($tag);
|
||||||
|
&render_struct_field($_) for @fields;
|
||||||
|
|
||||||
|
return if $tag->findnodes("ancestor-or-self::ld:field[\@is-union='true']");
|
||||||
|
|
||||||
|
local $in_struct_body = 0;
|
||||||
|
|
||||||
|
my $want_ctor = 0;
|
||||||
|
my $ctor_args = '';
|
||||||
|
my $ctor_arg_init = '';
|
||||||
|
|
||||||
|
with_emit_static {
|
||||||
|
local @simple_inits;
|
||||||
|
my @ctor_lines = with_emit {
|
||||||
|
if ($flags{-class}) {
|
||||||
|
$ctor_args = "virtual_identity *_id";
|
||||||
|
$ctor_arg_init = " = &".$name."::_identity";
|
||||||
|
push @simple_inits, "$flags{-inherits}(_id)" if $flags{-inherits};
|
||||||
|
emit "_identity.adjust_vtable(this, _id);";
|
||||||
|
}
|
||||||
|
render_field_init($_, '') for @fields;
|
||||||
|
};
|
||||||
|
if (@simple_inits || @ctor_lines) {
|
||||||
|
$want_ctor = 1;
|
||||||
|
my $full_name = get_struct_field_type($tag);
|
||||||
|
emit $full_name,'::',$name,"($ctor_args)";
|
||||||
|
emit " : ", join(', ', @simple_inits) if @simple_inits;
|
||||||
|
emit_block {
|
||||||
|
emit $_ for @ctor_lines;
|
||||||
|
};
|
||||||
|
}
|
||||||
|
} 'ctors';
|
||||||
|
|
||||||
|
if ($want_ctor) {
|
||||||
|
emit "$name($ctor_args$ctor_arg_init);";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
@ -0,0 +1,192 @@
|
|||||||
|
package StructType;
|
||||||
|
|
||||||
|
use utf8;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use Exporter ();
|
||||||
|
our $VERSION = 1.00;
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(
|
||||||
|
&render_struct_type
|
||||||
|
);
|
||||||
|
our %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
|
||||||
|
our @EXPORT_OK = qw( );
|
||||||
|
}
|
||||||
|
|
||||||
|
END { }
|
||||||
|
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
|
use Common;
|
||||||
|
use StructFields;
|
||||||
|
|
||||||
|
# MISC
|
||||||
|
|
||||||
|
sub translate_lookup($) {
|
||||||
|
my ($str) = @_;
|
||||||
|
return undef unless $str && $str =~ /^\$global((\.[_a-zA-Z0-9]+)+)$/;
|
||||||
|
my @fields = split /\./, substr($1,1);
|
||||||
|
my $expr = "df::global::".shift(@fields);
|
||||||
|
for my $fn (@fields) {
|
||||||
|
$expr = "_toref($expr).$fn";
|
||||||
|
}
|
||||||
|
return $expr;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub emit_find_instance {
|
||||||
|
my ($tag) = @_;
|
||||||
|
|
||||||
|
my $instance_vector = translate_lookup $tag->getAttribute('instance-vector');
|
||||||
|
if ($instance_vector) {
|
||||||
|
emit "static std::vector<$typename*> &get_vector();";
|
||||||
|
emit "static $typename *find(int id);";
|
||||||
|
|
||||||
|
with_emit_static {
|
||||||
|
emit_block {
|
||||||
|
emit "return ", $instance_vector, ";";
|
||||||
|
} "std::vector<$typename*>& ${typename}::get_vector() ";
|
||||||
|
|
||||||
|
emit_block {
|
||||||
|
emit "std::vector<$typename*> &vec_ = get_vector();";
|
||||||
|
|
||||||
|
if (my $id = $tag->getAttribute('key-field')) {
|
||||||
|
emit "return binsearch_in_vector(vec_, &${typename}::$id, id_);";
|
||||||
|
} else {
|
||||||
|
emit "return (id_ >= 0 && id_ < vec_.size()) ? vec_[id_] : NULL;";
|
||||||
|
}
|
||||||
|
} "$typename *${typename}::find(int id_) ";
|
||||||
|
};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub render_virtual_methods {
|
||||||
|
my ($tag) = @_;
|
||||||
|
|
||||||
|
# Collect all parent classes
|
||||||
|
my @parents = ( $tag );
|
||||||
|
for (;;) {
|
||||||
|
my $inherits = $parents[0]->getAttribute('inherits-from') or last;
|
||||||
|
my $parent = $types{$inherits} || die "Unknown parent: $inherits\n";
|
||||||
|
unshift @parents, $parent;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Build the vtable array
|
||||||
|
my %name_index;
|
||||||
|
my @vtable;
|
||||||
|
my @starts;
|
||||||
|
my $dtor_id = '~destructor';
|
||||||
|
|
||||||
|
for my $type (@parents) {
|
||||||
|
push @starts, scalar(@vtable);
|
||||||
|
for my $method ($type->findnodes('virtual-methods/vmethod')) {
|
||||||
|
my $is_destructor = is_attr_true($method, 'is-destructor');
|
||||||
|
my $name = $is_destructor ? $dtor_id : $method->getAttribute('name');
|
||||||
|
if ($name) {
|
||||||
|
die "Duplicate method: $name in ".$type->getAttribute('type-name')."\n"
|
||||||
|
if exists $name_index{$name};
|
||||||
|
$name_index{$name} = scalar(@vtable);
|
||||||
|
}
|
||||||
|
push @vtable, $method;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Ensure there is a destructor to avoid warnings
|
||||||
|
my $dtor_idx = $name_index{$dtor_id};
|
||||||
|
unless (defined $dtor_idx) {
|
||||||
|
for (my $i = 0; $i <= $#vtable; $i++) {
|
||||||
|
next if $vtable[$i]->getAttribute('name');
|
||||||
|
$name_index{$dtor_id} = $dtor_idx = $i;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
unless (defined $dtor_idx) {
|
||||||
|
push @vtable, undef;
|
||||||
|
$dtor_idx = $#vtable;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Generate the methods
|
||||||
|
my $min_id = $starts[-1];
|
||||||
|
my $cur_mode = '';
|
||||||
|
for (my $idx = $min_id; $idx <= $#vtable; $idx++) {
|
||||||
|
my $method = $vtable[$idx];
|
||||||
|
my $is_destructor = 1;
|
||||||
|
my $name = $typename;
|
||||||
|
my $is_anon = 1;
|
||||||
|
|
||||||
|
if ($method) {
|
||||||
|
$is_destructor = is_attr_true($method, 'is-destructor');
|
||||||
|
$name = $method->getAttribute('name') unless $is_destructor;
|
||||||
|
$is_anon = 0 if $name;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $rq_mode = $is_anon ? 'protected' : 'public';
|
||||||
|
unless ($rq_mode eq $cur_mode) {
|
||||||
|
$cur_mode = $rq_mode;
|
||||||
|
outdent { emit "$cur_mode:"; }
|
||||||
|
}
|
||||||
|
|
||||||
|
with_anon {
|
||||||
|
$name = ensure_name $name;
|
||||||
|
$method->setAttribute('ld:anon-name', $name) if $method && $is_anon;
|
||||||
|
|
||||||
|
my @ret_type = $is_destructor ? () : $method->findnodes('ret-type');
|
||||||
|
my @arg_types = $is_destructor ? () : $method->findnodes('ld:field');
|
||||||
|
my $ret_type = $ret_type[0] ? get_struct_field_type($ret_type[0], -local => 1) : 'void';
|
||||||
|
my @arg_strs = map { scalar get_struct_field_type($_, -local => 1) } @arg_types;
|
||||||
|
|
||||||
|
my $ret_stmt = '';
|
||||||
|
unless ($ret_type eq 'void') {
|
||||||
|
$ret_stmt = ' return '.($ret_type =~ /\*$/ ? '0' : "$ret_type()").'; ';
|
||||||
|
}
|
||||||
|
|
||||||
|
emit 'virtual ', ($is_destructor?'~':$ret_type.' '), $name,
|
||||||
|
'(', join(', ', @arg_strs), ') {', $ret_stmt, '}; //', $idx;
|
||||||
|
} "anon_vmethod_$idx";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub render_struct_type {
|
||||||
|
my ($tag) = @_;
|
||||||
|
|
||||||
|
my $tag_name = $tag->getAttribute('ld:meta');
|
||||||
|
my $is_class = ($tag_name eq 'class-type');
|
||||||
|
my $has_methods = $is_class || is_attr_true($tag, 'has-methods');
|
||||||
|
my $inherits = $tag->getAttribute('inherits-from');
|
||||||
|
my $original_name = $tag->getAttribute('original-name');
|
||||||
|
my $ispec = '';
|
||||||
|
|
||||||
|
if ($inherits) {
|
||||||
|
register_ref $inherits, 1;
|
||||||
|
$ispec = ' : '.$inherits;
|
||||||
|
} elsif ($is_class) {
|
||||||
|
$ispec = ' : virtual_class';
|
||||||
|
}
|
||||||
|
|
||||||
|
with_struct_block {
|
||||||
|
emit_struct_fields($tag, $typename, -class => $is_class, -inherits => $inherits);
|
||||||
|
emit_find_instance($tag);
|
||||||
|
|
||||||
|
if ($has_methods) {
|
||||||
|
if ($is_class) {
|
||||||
|
emit "static class_virtual_identity<$typename> _identity;";
|
||||||
|
with_emit_static {
|
||||||
|
emit "class_virtual_identity<$typename> ${typename}::_identity(",
|
||||||
|
"\"$typename\",",
|
||||||
|
($original_name ? "\"$original_name\"" : 'NULL'), ',',
|
||||||
|
($inherits ? "&${inherits}::_identity" : 'NULL'),
|
||||||
|
");";
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($is_class) {
|
||||||
|
render_virtual_methods $tag;
|
||||||
|
} else {
|
||||||
|
emit "~",$typename,"() {}";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} $tag, "$typename$ispec", -export => 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
@ -0,0 +1,289 @@
|
|||||||
|
<?xml version="1.0" encoding="ISO-8859-1"?>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
The original XML format is good for human use, but
|
||||||
|
difficult to interpret during code generation. This
|
||||||
|
lowers it to more repetitive & verbose, but easier
|
||||||
|
for the programs to interpret.
|
||||||
|
|
||||||
|
This is the first pass that folds all field tags into ld:field.
|
||||||
|
-->
|
||||||
|
<xsl:stylesheet version="1.0"
|
||||||
|
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
|
||||||
|
xmlns:ld="http://github.com/peterix/dfhack/lowered-data-definition">
|
||||||
|
<!--
|
||||||
|
Global templates:
|
||||||
|
|
||||||
|
- Copy attributes and simple tags
|
||||||
|
- Bail out on unexpected tags
|
||||||
|
-->
|
||||||
|
|
||||||
|
<xsl:template match="@*">
|
||||||
|
<xsl:copy-of select='.'/>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="*">
|
||||||
|
<xsl:message terminate="yes">
|
||||||
|
Error: Unexpected tag: <xsl:value-of select='name(.)'/>
|
||||||
|
</xsl:message>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="/data-definition">
|
||||||
|
<ld:data-definition>
|
||||||
|
<xsl:apply-templates select='@*|node()'/>
|
||||||
|
</ld:data-definition>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="comment|code-helper|enum-attr|enum-item|item-attr">
|
||||||
|
<xsl:copy>
|
||||||
|
<xsl:apply-templates select='@*|node()'/>
|
||||||
|
</xsl:copy>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="virtual-methods|cond-if|cond-else">
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<xsl:copy>
|
||||||
|
<xsl:apply-templates select='@*|node()'>
|
||||||
|
<xsl:with-param name='level' select="$level"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:copy>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Type defs: convert to one common 'global-type' tag name. -->
|
||||||
|
|
||||||
|
<xsl:template match='enum-type|bitfield-type|class-type|struct-type'>
|
||||||
|
<ld:global-type>
|
||||||
|
<xsl:attribute name='ld:meta'><xsl:value-of select='name(.)'/></xsl:attribute>
|
||||||
|
<xsl:attribute name='ld:level'>0</xsl:attribute>
|
||||||
|
<xsl:apply-templates select='@*|node()'>
|
||||||
|
<xsl:with-param name='level' select="1"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</ld:global-type>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Code to properly annotate references to types by name -->
|
||||||
|
|
||||||
|
<xsl:key name="primitive-type-lookup" match="prim-type" use="@ld:subtype"/>
|
||||||
|
<xsl:variable name="primitive-types-top" select="document('')/*/ld:primitive-types"/>
|
||||||
|
|
||||||
|
<xsl:template match="ld:primitive-types">
|
||||||
|
<xsl:param name="name"/>
|
||||||
|
<xsl:param name="level"/>
|
||||||
|
<xsl:param name="rq_global"/>
|
||||||
|
<xsl:variable name='item' select="key('primitive-type-lookup', $name)"/>
|
||||||
|
<xsl:choose>
|
||||||
|
<xsl:when test="$item">
|
||||||
|
<xsl:if test='$rq_global'>
|
||||||
|
<xsl:message terminate="yes">
|
||||||
|
Error: Cannot refer to primitive types from <xsl:value-of select='$rq_global'/>
|
||||||
|
</xsl:message>
|
||||||
|
</xsl:if>
|
||||||
|
<xsl:apply-templates select="$item/@*"/>
|
||||||
|
<xsl:apply-templates select="$item/*">
|
||||||
|
<xsl:with-param name='level' select="$level+1"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:when>
|
||||||
|
<xsl:otherwise>
|
||||||
|
<xsl:attribute name='ld:meta'>global</xsl:attribute>
|
||||||
|
<xsl:attribute name='type-name'><xsl:value-of select='$name'/></xsl:attribute>
|
||||||
|
</xsl:otherwise>
|
||||||
|
</xsl:choose>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template name="lookup-type-ref">
|
||||||
|
<xsl:param name='name'/>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<xsl:param name='rq_global'/>
|
||||||
|
<xsl:attribute name='ld:level'><xsl:value-of select='$level'/></xsl:attribute>
|
||||||
|
<xsl:apply-templates select="$primitive-types-top">
|
||||||
|
<xsl:with-param name="name" select="$name"/>
|
||||||
|
<xsl:with-param name="level" select="$level"/>
|
||||||
|
<xsl:with-param name="rq_global" select="$rq_global"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
Fields:
|
||||||
|
|
||||||
|
- Fold into one generic 'field' tag.
|
||||||
|
- Add a 'level' attribute to assist in searching by name.
|
||||||
|
-->
|
||||||
|
|
||||||
|
<!-- Primitive types: -->
|
||||||
|
<ld:primitive-types>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='int8_t' ld:bits='8'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='uint8_t' ld:unsigned='true' ld:bits='8'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='int16_t' ld:bits='16'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='uint16_t' ld:unsigned='true' ld:bits='16'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='int32_t' ld:bits='32'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='uint32_t' ld:unsigned='true' ld:bits='32'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='int64_t' ld:bits='64'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='uint64_t' ld:unsigned='true' ld:bits='64'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='bool' ld:bits='8'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='s-float' ld:bits='32'/>
|
||||||
|
<prim-type ld:meta='number' ld:subtype='flag-bit' ld:bits='1'/>
|
||||||
|
|
||||||
|
<prim-type ld:meta='bytes' ld:subtype='padding'/>
|
||||||
|
<prim-type ld:meta='bytes' ld:subtype='static-string'/>
|
||||||
|
|
||||||
|
<prim-type ld:meta='pointer' ld:subtype='pointer'/>
|
||||||
|
<prim-type ld:meta='pointer' ld:subtype='ptr-string' ld:is-container='true'>
|
||||||
|
<static-string/>
|
||||||
|
</prim-type>
|
||||||
|
|
||||||
|
<prim-type ld:meta='primitive' ld:subtype='stl-string'/>
|
||||||
|
</ld:primitive-types>
|
||||||
|
|
||||||
|
<xsl:template match='int8_t|uint8_t|int16_t|uint16_t|int32_t|uint32_t|int64_t|uint64_t|bool|flag-bit|s-float|padding|static-string|ptr-string|stl-string'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<ld:field>
|
||||||
|
<xsl:apply-templates select='@*'/>
|
||||||
|
<xsl:call-template name='lookup-type-ref'>
|
||||||
|
<xsl:with-param name="name" select="name(.)"/>
|
||||||
|
<xsl:with-param name="level" select="$level"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
<xsl:apply-templates select='node()'/>
|
||||||
|
</ld:field>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
Compound, enum or bitfield:
|
||||||
|
|
||||||
|
- When a proxy: meta='global' subtype='$tag' type-name='blah'
|
||||||
|
- When an ad-hoc compound: meta='compound' subtype='$tag'
|
||||||
|
- Level not incremented unless it has a name.
|
||||||
|
-->
|
||||||
|
<xsl:template name='compound'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<xsl:param name='level_shift' select='1'/>
|
||||||
|
<xsl:param name='rq_global'/>
|
||||||
|
<xsl:apply-templates select='@*'/>
|
||||||
|
<xsl:choose>
|
||||||
|
<xsl:when test='@type-name'>
|
||||||
|
<xsl:call-template name='lookup-type-ref'>
|
||||||
|
<xsl:with-param name='name' select="@type-name"/>
|
||||||
|
<xsl:with-param name="level" select="$level"/>
|
||||||
|
<xsl:with-param name='rq_global' select="$rq_global"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
<xsl:apply-templates select='node()'/>
|
||||||
|
</xsl:when>
|
||||||
|
<xsl:otherwise>
|
||||||
|
<xsl:attribute name='ld:level'><xsl:value-of select='$level'/></xsl:attribute>
|
||||||
|
<xsl:attribute name='ld:meta'>compound</xsl:attribute>
|
||||||
|
<xsl:apply-templates select='node()'>
|
||||||
|
<xsl:with-param name='level' select="$level+$level_shift"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:otherwise>
|
||||||
|
</xsl:choose>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match='compound'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<ld:field>
|
||||||
|
<xsl:if test="not(@name|@type-name)">
|
||||||
|
<xsl:attribute name='ld:anon-compound'>true</xsl:attribute>
|
||||||
|
</xsl:if>
|
||||||
|
<xsl:call-template name='compound'>
|
||||||
|
<xsl:with-param name='level' select="$level"/>
|
||||||
|
<xsl:with-param name='level_shift' select="count(@name)"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</ld:field>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match='bitfield|enum'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<ld:field>
|
||||||
|
<xsl:attribute name='ld:subtype'><xsl:value-of select='name(.)'/></xsl:attribute>
|
||||||
|
<xsl:call-template name='compound'>
|
||||||
|
<xsl:with-param name='level' select="$level"/>
|
||||||
|
<xsl:with-param name='rq_global' select="name(.)"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</ld:field>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Generic container helper: resolve type-name to a field, then process subtags. -->
|
||||||
|
<xsl:template name='container'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<xsl:attribute name='ld:is-container'>true</xsl:attribute>
|
||||||
|
<xsl:choose>
|
||||||
|
<xsl:when test='@type-name'>
|
||||||
|
<ld:field>
|
||||||
|
<xsl:call-template name='lookup-type-ref'>
|
||||||
|
<xsl:with-param name='name' select="@type-name"/>
|
||||||
|
<xsl:with-param name="level" select="$level"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</ld:field>
|
||||||
|
<xsl:apply-templates select='node()'/>
|
||||||
|
</xsl:when>
|
||||||
|
<xsl:otherwise>
|
||||||
|
<xsl:apply-templates select='node()'>
|
||||||
|
<xsl:with-param name='level' select="$level"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:otherwise>
|
||||||
|
</xsl:choose>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Special containers: meta='$tag' -->
|
||||||
|
<xsl:template match='static-array|pointer'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<ld:field>
|
||||||
|
<xsl:attribute name='ld:level'><xsl:value-of select='$level'/></xsl:attribute>
|
||||||
|
<xsl:attribute name='ld:meta'><xsl:value-of select='name(.)'/></xsl:attribute>
|
||||||
|
<xsl:apply-templates select='@*'/>
|
||||||
|
<xsl:call-template name='container'>
|
||||||
|
<xsl:with-param name='level' select="$level+1"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</ld:field>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Misc containers: meta='container' subtype='$tag' -->
|
||||||
|
<xsl:template match='stl-vector|df-flagarray|stl-bit-vector'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<ld:field ld:meta='container'>
|
||||||
|
<xsl:attribute name='ld:level'><xsl:value-of select='$level'/></xsl:attribute>
|
||||||
|
<xsl:attribute name='ld:subtype'><xsl:value-of select='name(.)'/></xsl:attribute>
|
||||||
|
<xsl:apply-templates select='@*'/>
|
||||||
|
<xsl:call-template name='container'>
|
||||||
|
<xsl:with-param name='level' select="$level+1"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</ld:field>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Virtual methods -->
|
||||||
|
|
||||||
|
<xsl:template match='vmethod'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<xsl:copy>
|
||||||
|
<xsl:attribute name='ld:level'><xsl:value-of select='$level'/></xsl:attribute>
|
||||||
|
<xsl:apply-templates select='@*'/>
|
||||||
|
<xsl:if test='@ret-type'>
|
||||||
|
<xsl:copy-of select='text()[1]'/>
|
||||||
|
<ret-type>
|
||||||
|
<xsl:call-template name='lookup-type-ref'>
|
||||||
|
<xsl:with-param name='name' select="@ret-type"/>
|
||||||
|
<xsl:with-param name="level" select="$level+1"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</ret-type>
|
||||||
|
</xsl:if>
|
||||||
|
<xsl:apply-templates select='node()'>
|
||||||
|
<xsl:with-param name='level' select="$level+1"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:copy>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match='ret-type'>
|
||||||
|
<xsl:param name='level' select='-1'/>
|
||||||
|
<xsl:copy>
|
||||||
|
<xsl:call-template name='compound'>
|
||||||
|
<xsl:with-param name='level' select="$level"/>
|
||||||
|
</xsl:call-template>
|
||||||
|
</xsl:copy>
|
||||||
|
</xsl:template>
|
||||||
|
</xsl:stylesheet>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
Local Variables:
|
||||||
|
indent-tabs-mode: nil
|
||||||
|
nxml-child-indent: 4
|
||||||
|
End:
|
||||||
|
-->
|
||||||
@ -0,0 +1,78 @@
|
|||||||
|
<?xml version="1.0" encoding="ISO-8859-1"?>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
Second pass of lowering:
|
||||||
|
- Detect incorrectly placed fields
|
||||||
|
- Fold container item fields into a single ld:item subelement.
|
||||||
|
-->
|
||||||
|
<xsl:stylesheet version="1.0"
|
||||||
|
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
|
||||||
|
xmlns:ld="http://github.com/peterix/dfhack/lowered-data-definition">
|
||||||
|
<!-- Generic walk -->
|
||||||
|
<xsl:template match="@*">
|
||||||
|
<xsl:copy-of select='.'/>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="*">
|
||||||
|
<xsl:copy>
|
||||||
|
<xsl:apply-templates select='@*|node()'/>
|
||||||
|
</xsl:copy>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Detect invalid fields & methods -->
|
||||||
|
<xsl:template match="ld:field[not(@ld:level) or (@ld:level < 0)]" priority='10'>
|
||||||
|
<xsl:message terminate='yes'>
|
||||||
|
Unexpected field: <xsl:copy-of select='.'/>
|
||||||
|
</xsl:message>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="ld:vmethod[not(@ld:level) or not(@ld:level = 1)]" priority='10'>
|
||||||
|
<xsl:message terminate='yes'>
|
||||||
|
Unexpected method: <xsl:copy-of select='.'/>
|
||||||
|
</xsl:message>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<!-- Unify containers -->
|
||||||
|
<xsl:template match="ld:field" priority='8'>
|
||||||
|
<xsl:param name="tag" select="name(.)"/>
|
||||||
|
<xsl:element name='{$tag}'>
|
||||||
|
<xsl:apply-templates select='@*|node()'/>
|
||||||
|
</xsl:element>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match="*[@ld:is-container]" priority='9'>
|
||||||
|
<xsl:param name="tag" select="name(.)"/>
|
||||||
|
<xsl:element name='{$tag}'>
|
||||||
|
<xsl:apply-templates select='@*'/>
|
||||||
|
<xsl:choose>
|
||||||
|
<xsl:when test='count(ld:field) <= 1'>
|
||||||
|
<xsl:apply-templates select='node()'>
|
||||||
|
<xsl:with-param name='tag' select="'ld:item'"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:when>
|
||||||
|
<xsl:otherwise>
|
||||||
|
<!-- This destroys formatting, but it seems inevitable. -->
|
||||||
|
<xsl:copy-of select='text()[1]'/>
|
||||||
|
<ld:item ld:meta='compound'>
|
||||||
|
<xsl:attribute name='ld:level'><xsl:value-of select='@ld:level'/></xsl:attribute>
|
||||||
|
<xsl:apply-templates select='ld:field|text()'/>
|
||||||
|
</ld:item>
|
||||||
|
<xsl:apply-templates select='node()[not(self::ld:field)]'/>
|
||||||
|
</xsl:otherwise>
|
||||||
|
</xsl:choose>
|
||||||
|
</xsl:element>
|
||||||
|
</xsl:template>
|
||||||
|
|
||||||
|
<xsl:template match='ret-type[count(ld:field)=1]'>
|
||||||
|
<xsl:apply-templates select='ld:field'>
|
||||||
|
<xsl:with-param name='tag' select="'ret-type'"/>
|
||||||
|
</xsl:apply-templates>
|
||||||
|
</xsl:template>
|
||||||
|
</xsl:stylesheet>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
Local Variables:
|
||||||
|
indent-tabs-mode: nil
|
||||||
|
nxml-child-indent: 4
|
||||||
|
End:
|
||||||
|
-->
|
||||||
Loading…
Reference in New Issue