Use the updated code generator with support for vtables & constructors.

develop
Alexander Gavrilov 2011-12-29 16:30:55 +04:00
parent 16241a7e78
commit d513e75365
16 changed files with 1519 additions and 855 deletions

@ -1078,6 +1078,8 @@
<Group name="Notes" description="In-game notes">
<Address name="vector"/>
</Group>
<Group name='vtable'>
</Group>
<Group name='global'>
<Address name='world'/>
<Address name='ui'/>
@ -2316,6 +2318,8 @@
<Group name="World">
<Address name="save_folder" value="0x1847A40" />
</Group>
<Group name='vtable'>
</Group>
<Group name='global'>
<Address name='world' value='0x16b0a58'/>
<Address name='ui' value='0x14ee7e0'/>
@ -3188,6 +3192,8 @@
<Group name="Notes">
<Address name="vector" value="0x93f635c"/>
</Group>
<Group name='vtable'>
</Group>
<Group name='global'>
<Address name='world' value='0x93f77a0'/>
<Address name='ui' value='0x93f0780'/>

@ -67,6 +67,7 @@ SET(PROJECT_SRCS
Core.cpp
DataDefs.cpp
DataStatics.cpp
DataStaticsCtor.cpp
PluginManager.cpp
TileTypes.cpp
VersionInfo.cpp
@ -134,6 +135,7 @@ LIST(APPEND PROJECT_SRCS ${PROJECT_HDRS})
SET_SOURCE_FILES_PROPERTIES(${GENERATED_HDRS} PROPERTIES HEADER_FILE_ONLY TRUE GENERATED TRUE)
FILE(GLOB GENERATE_INPUT_SCRIPTS ${dfapi_SOURCE_DIR}/xml/*.pm ${dfapi_SOURCE_DIR}/xml/*.xslt)
FILE(GLOB GENERATE_INPUT_XMLS ${dfapi_SOURCE_DIR}/xml/*.xml)
ADD_CUSTOM_COMMAND(
@ -141,7 +143,7 @@ ADD_CUSTOM_COMMAND(
COMMAND perl xml/codegen.pl xml include/dfhack/df
WORKING_DIRECTORY ${dfapi_SOURCE_DIR}
MAIN_DEPENDENCY ${dfapi_SOURCE_DIR}/xml/codegen.pl
DEPENDS ${GENERATE_INPUT_XMLS}
DEPENDS ${GENERATE_INPUT_XMLS} ${GENERATE_INPUT_SCRIPTS}
)
ADD_CUSTOM_TARGET(generate_headers DEPENDS ${dfapi_SOURCE_DIR}/include/dfhack/df/static.inc)

@ -497,7 +497,7 @@ bool Core::Init()
}
// initialize data defs
virtual_identity::Init();
virtual_identity::Init(this);
InitDataDefGlobals(this);
// create mutex for syncing with interactive tasks

@ -78,31 +78,62 @@ virtual_identity *virtual_identity::get(virtual_ptr instance_ptr)
for (virtual_identity *p = list; p; p = p->next) {
if (strcmp(name.c_str(), p->getOriginalName()) != 0) continue;
if (p->vtable_ptr && p->vtable_ptr != vtable) {
std::cerr << "Conflicting vtable ptr for class '" << p->getName()
<< "': found 0x" << std::hex << unsigned(vtable)
<< ", previous 0x" << unsigned(p->vtable_ptr) << std::dec << std::endl;
abort();
} else if (!p->vtable_ptr) {
std::cerr << "class '" << p->getName() << "': vtable = 0x"
<< std::hex << unsigned(vtable) << std::dec << std::endl;
}
known[vtable] = p;
p->vtable_ptr = vtable;
return p;
}
std::cerr << "UNKNOWN CLASS '" << name << "': vtable = 0x"
<< std::hex << unsigned(vtable) << std::dec << std::endl;
known[vtable] = NULL;
return NULL;
}
bool virtual_identity::check_instance(virtual_ptr instance_ptr, bool allow_subclasses)
bool virtual_identity::is_subclass(virtual_identity *actual)
{
virtual_identity *actual = get(instance_ptr);
if (actual == this) return true;
if (!allow_subclasses || !actual) return false;
do {
actual = actual->parent;
for (; actual; actual = actual->parent)
if (actual == this) return true;
} while (actual);
return false;
}
void virtual_identity::Init()
void virtual_identity::adjust_vtable(virtual_ptr obj, virtual_identity *main)
{
if (vtable_ptr) {
*(void**)obj = vtable_ptr;
return;
}
if (main && main != this && is_subclass(main))
return;
std::cerr << "Attempt to create class '" << getName() << "' without known vtable." << std::endl;
abort();
}
virtual_ptr virtual_identity::clone(virtual_ptr obj)
{
virtual_identity *id = get(obj);
if (!id) return NULL;
virtual_ptr copy = id->instantiate();
if (!copy) return NULL;
id->do_copy(copy, obj);
return copy;
}
void virtual_identity::Init(Core *core)
{
if (!known_mutex)
known_mutex = new tthread::mutex();
@ -119,6 +150,14 @@ void virtual_identity::Init()
p->parent->has_children = true;
}
}
// Read pre-filled vtable ptrs
OffsetGroup *ptr_table = core->vinfo->getGroup("vtable");
for (virtual_identity *p = list; p; p = p->next) {
uint32_t tmp;
if (ptr_table->getSafeAddress(p->getName(),tmp))
p->vtable_ptr = (void*)tmp;
}
}
#define GLOBAL(name,tname) \

@ -15,3 +15,4 @@ namespace {
// Instantiate all the static objects
#include "dfhack/df/static.inc"
#include "dfhack/df/static.enums.inc"

@ -0,0 +1,6 @@
#include "Internal.h"
#include "dfhack/DataDefs.h"
#include "dfhack/MiscUtils.h"
// Object constructors
#include "dfhack/df/static.ctors.inc"

@ -62,8 +62,6 @@ namespace DFHack
protected:
virtual_identity(const char *dfhack_name, const char *original_name, virtual_identity *parent);
bool check_instance(virtual_ptr instance_ptr, bool allow_subclasses);
static void *get_vtable(virtual_ptr instance_ptr) { return *(void**)instance_ptr; }
public:
@ -73,8 +71,10 @@ namespace DFHack
virtual_identity *getParent() { return parent; }
const std::vector<virtual_identity*> &getChildren() { return children; }
public:
static virtual_identity *get(virtual_ptr instance_ptr);
bool is_subclass(virtual_identity *subtype);
bool is_instance(virtual_ptr instance_ptr) {
if (!instance_ptr) return false;
if (vtable_ptr) {
@ -82,16 +82,28 @@ namespace DFHack
if (vtable == vtable_ptr) return true;
if (!has_children) return false;
}
return check_instance(instance_ptr, true);
return is_subclass(get(instance_ptr));
}
bool is_direct_instance(virtual_ptr instance_ptr) {
if (!instance_ptr) return false;
return vtable_ptr ? (vtable_ptr == get_vtable(instance_ptr))
: check_instance(instance_ptr, false);
: (this == get(instance_ptr));
}
static void Init();
public:
bool can_instantiate() { return (vtable_ptr != NULL); }
virtual_ptr instantiate() { return can_instantiate() ? do_instantiate() : NULL; }
static virtual_ptr clone(virtual_ptr obj);
protected:
virtual virtual_ptr do_instantiate() = 0;
virtual void do_copy(virtual_ptr tgt, virtual_ptr src) = 0;
public:
static void Init(Core *core);
// Strictly for use in virtual class constructors
void adjust_vtable(virtual_ptr obj, virtual_identity *main);
};
template<class T>
@ -112,14 +124,23 @@ namespace DFHack
namespace df
{
using DFHack::virtual_ptr;
using DFHack::virtual_identity;
using DFHack::virtual_class;
using DFHack::BitArray;
template<class T>
class class_virtual_identity : public DFHack::virtual_identity {
class class_virtual_identity : public virtual_identity {
public:
class_virtual_identity(const char *dfhack_name, const char *original_name, virtual_identity *parent)
: virtual_identity(dfhack_name, original_name, parent) {};
T *instantiate() { return static_cast<T*>(virtual_identity::instantiate()); }
T *clone(T* obj) { return static_cast<T*>(virtual_identity::clone(obj)); }
protected:
virtual virtual_ptr do_instantiate() { return new T(); }
virtual void do_copy(virtual_ptr tgt, virtual_ptr src) { *static_cast<T*>(tgt) = *static_cast<T*>(src); }
};
template<class EnumType, class IntType = int32_t>
@ -148,6 +169,8 @@ namespace df
namespace df {
#define DF_KNOWN_GLOBALS \
GLOBAL(cursor,cursor) \
GLOBAL(selection_rect,selection_rect) \
GLOBAL(world,world) \
GLOBAL(ui,ui) \
GLOBAL(gview,interface) \

@ -1,2 +1,3 @@
*.h
*.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 &register_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;

@ -2,845 +2,47 @@
use strict;
use warnings;
use XML::LibXML;
my $input_dir = $ARGV[0] || '.';
my $output_dir = $ARGV[1] || 'codegen';
my $main_namespace = $ARGV[2] || 'df';
my $export_prefix = 'DFHACK_EXPORT ';
my %types;
my %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 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";
BEGIN {
our $script_root = '.';
if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
$script_root = $1;
unshift @INC, $1;
}
return $expr;
}
# 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) = @_;
$prefix ||= '';
$suffix ||= '';
emit $prefix,'{';
&indent($blk);
emit '}',$suffix;
}
# Static file output
my @static_lines;
my %static_includes;
sub with_emit_static(&) {
my ($blk) = @_;
$static_includes{$typename}++;
push @static_lines, &with_emit($blk,2);
}
# 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->();
}
# 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 ptr-string stl-string flag-bit
pointer);
my %primitive_aliases = (
'stl-string' => 'std::string',
'ptr-string' => 'char*',
'flag-bit' => 'void',
'pointer' => 'void*',
's-float' => 'float',
);
my %primitive_types;
$primitive_types{$_}++ for @primitive_type_list;
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;
}
# 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}++;
}
}
}
# Determines if referenced other types should be included or forward-declared
our $is_strong_ref = 1;
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 $is_strong_ref = 1; # reset the state
if ($flags{-no_anon}) {
$blk->();
} else {
&with_anon($blk);
}
} $prefix, ";";
}
sub decode_type_name_ref($;%) {
# Interpret the type-name field of a tag
my ($tag,%flags) = @_;
my $force_type = $flags{-force_type};
my $force_strong = $flags{-force_strong};
my $tname = $tag->getAttribute($flags{-attr_name} || 'type-name')
or return undef;
if ($primitive_types{$tname}) {
die "Cannot use type $tname as type-name of ".$tag->nodeName."\n"
if ($force_type && $force_type ne 'primitive');
return primitive_type_name($tname);
} else {
register_ref $tname, ($force_strong||$is_strong_ref);
die "Cannot use type $tname as type-name of ".$tag->nodeName."\n"
if ($force_type && $force_type ne $types{$tname}->nodeName);
return $main_namespace.'::'.$tname;
}
}
# CONDITIONALS
sub is_conditional($) {
my ($tag) = @_;
return $tag->nodeName =~ /^(cond-if|cond-elseif)$/;
}
sub translate_if_cond($) {
my ($tag) = @_;
my @rules;
if (my $defvar = $tag->getAttribute('defined')) {
push @rules, "defined($defvar)";
}
if (my $cmpvar = $tag->getAttribute('var')) {
if (my $cmpval = $tag->getAttribute('lt')) {
push @rules, "($cmpvar < $cmpval)";
}
if (my $cmpval = $tag->getAttribute('le')) {
push @rules, "($cmpvar <= $cmpval)";
}
if (my $cmpval = $tag->getAttribute('eq')) {
push @rules, "($cmpvar == $cmpval)";
}
if (my $cmpval = $tag->getAttribute('ge')) {
push @rules, "($cmpvar >= $cmpval)";
}
if (my $cmpval = $tag->getAttribute('gt')) {
push @rules, "($cmpvar > $cmpval)";
}
if (my $cmpval = $tag->getAttribute('ne')) {
push @rules, "($cmpvar != $cmpval)";
}
}
return '('.(join(' && ',@rules) || '1').')';
}
our $in_cond = 0;
sub render_cond_if($$$;@) {
my ($tag, $in_elseif, $render_cb, @tail) = @_;
local $in_cond = 1;
{
local $indentation = 0;
my $op = ($in_elseif && $in_elseif >= 2) ? '#elif' : '#if';
emit $op, ' ', translate_if_cond($tag);
}
for my $child ($tag->findnodes('child::*')) {
&render_cond($child, $render_cb, @tail);
}
unless ($in_elseif) {
local $indentation = 0;
emit "#endif";
}
}
sub render_cond($$;@) {
my ($tag, $render_cb, @tail) = @_;
my $tag_name = $tag->nodeName;
if ($tag_name eq 'cond-if') {
render_cond_if($tag, 0, $render_cb, @tail);
} elsif ($tag_name eq 'cond-elseif') {
my $idx = 1;
for my $child ($tag->findnodes('child::*')) {
($child->nodeName eq 'cond-if')
or die "Only cond-if tags may be inside a cond-switch: ".$child->nodeName."\n";
render_cond_if($child, $idx++, $render_cb, @tail);
}
{
local $indentation = 0;
emit "#endif";
}
} else {
local $_ = $tag;
$render_cb->($tag, @tail);
}
}
# ENUM
sub render_enum_core($$) {
my ($name,$tag) = @_;
my $base = 0;
emit_block {
my @items = $tag->findnodes('child::*');
my $idx = 0;
for my $item (@items) {
render_cond $item, sub {
my $tag = $_->nodeName;
return if $tag eq 'enum-attr';
($tag eq 'enum-item')
or die "Invalid enum member: ".$item->nodeName."\n";
my $name = ensure_name $_->getAttribute('name');
my $value = $_->getAttribute('value');
$base = ($idx == 0 && !$in_cond) ? $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);
for my $attr ($tag->findnodes('child::enum-attr')) {
my $name = $attr->getAttribute('name') or die "Unnamed enum-attr.\n";
my $type = $attr->getAttribute('type-name');
my $def = $attr->getAttribute('default-value');
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 @avals, (defined $def ? $def : "($type)0");
} else {
push @atypes, 'const char*';
push @avals, (defined $def ? "\"$def\"" : 'NULL');
}
}
# 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::*')) {
render_cond $item, sub {
my $tag = $_->nodeName;
return if $tag eq 'enum-attr';
# Assemble item-specific attr values
my @evals = @avals;
my $name = $_->getAttribute('name');
$evals[0] = "\"$name\"" if $name;
};
for my $attr ($_->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] = $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 ";
};
}
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,";";
}
# BITFIELD
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;
}
sub render_bitfield_core {
my ($name, $tag) = @_;
emit_block {
emit get_primitive_base($tag), ' whole;';
emit_block {
for my $item ($tag->findnodes('child::*')) {
render_cond $item, sub {
my ($item) = @_;
($item->nodeName eq 'flag-bit')
or die "Invalid bitfield member:".$item->nodeName."\n";
check_bad_attrs($item);
my $name = ensure_name $item->getAttribute('name');
my $size = $item->getAttribute('count') || 1;
emit "unsigned ", $name, " : ", $size, ";";
};
}
} "struct ", " bits;";
} "union $name ", ";";
}
sub render_bitfield_type {
my ($tag) = @_;
render_bitfield_core($typename,$tag);
}
# STRUCT
my %struct_field_handlers;
sub get_struct_fields($) {
# Retrieve subtags that are actual struct fields
my ($struct_tag) = @_;
local $_;
return grep {
my $tag = $_->nodeName;
die "Unknown field tag: $tag\n"
unless exists $struct_field_handlers{$tag};
$struct_field_handlers{$tag};
} $struct_tag->findnodes('child::*');
}
sub get_struct_field_type($) {
# Dispatch on the tag name, and retrieve the type prefix & suffix
my ($tag) = @_;
my $handler = $struct_field_handlers{$tag->nodeName}
or die "Unexpected tag: ".$tag->nodeName;
return $handler->($tag);
}
sub do_render_struct_field($) {
my ($tag) = @_;
my $tag_name = $tag->nodeName;
my $field_name = $tag->getAttribute('name');
# Special case: anonymous compounds.
if ($tag_name eq 'compound' && !defined $field_name &&
!defined $tag->getAttribute('type-name'))
{
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 $name = ensure_name $field_name;
with_anon {
my ($prefix, $postfix) = get_struct_field_type($tag);
emit $prefix, ' ', $name, $postfix, ';';
} "T_$name";
}
sub render_struct_field($) {
my ($tag) = @_;
render_cond $tag, \&do_render_struct_field;
}
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_container_item_type($$;$) {
# Interpret the type-name and nested fields for a generic container type
my ($tag,$strong_ref,$allow_void) = @_;
check_bad_attrs($tag);
my $prefix;
my $postfix = '';
local $is_strong_ref = $strong_ref;
unless ($prefix = decode_type_name_ref($tag)) {
my @fields = get_struct_fields($tag);
if (scalar(@fields) == 1 && !is_conditional($fields[0])) {
($prefix, $postfix) = get_struct_field_type($fields[0]);
} elsif (scalar(@fields) == 0) {
$allow_void or die "Empty container: ".$tag->nodeName."\n";
$prefix = $allow_void;
} else {
$prefix = ensure_name undef;
with_struct_block {
render_struct_field($_) for @fields;
} $tag, $prefix;
}
}
return ($prefix,$postfix) if wantarray;
return emit_typedef($prefix, $postfix) if $postfix;
return $prefix;
}
sub get_primitive_field_type {
# Primitive type handler
my ($tag,$fname) = @_;
check_bad_attrs($tag);
my $name = $tag->nodeName;
return (primitive_type_name($name), "");
}
sub get_static_string_type {
# Static string handler
my ($tag, $fname) = @_;
check_bad_attrs($tag, 1);
my $count = $tag->getAttribute('size') || 0;
return ('char', "[$count]");
}
sub get_padding_type {
# Padding handler. Supports limited alignment.
my ($tag, $fname) = @_;
check_bad_attrs($tag, 1, 1);
my $count = $tag->getAttribute('size') || 0;
my $align = $tag->getAttribute('alignment') || 1;
if ($align == 1) {
return ('char', "[$count]");
} elsif ($align == 2) {
($count % 2 == 0) or die "Size not aligned in padding: $count at $align\n";
return ('short', "[".($count/2)."]");
} elsif ($align == 4) {
($count % 4 == 0) or die "Size not aligned in padding: $count at $align\n";
return ('int', "[".($count/4)."]");
} else {
die "Bad padding alignment $align in $typename in $filename\n";
}
}
sub get_static_array_type {
# static-array handler
my ($tag, $fname) = @_;
my ($pre, $post) = get_container_item_type($tag, 1);
my $count = $tag->getAttribute('count')
or die "Count is mandatory for static-array in $typename in $filename\n";
return ($pre, "[$count]".$post);
}
sub get_pointer_type($) {
# pointer handler
my ($tag) = @_;
my $item = get_container_item_type($tag, 0, 'void');
return ($item.'*', '');
}
sub get_compound_type($) {
# compound (nested struct) handler
my ($tag) = @_;
check_bad_attrs($tag);
my $tname = decode_type_name_ref($tag);
unless ($tname) {
$tname = ensure_name undef;
with_struct_block {
render_struct_field($_) for get_struct_fields($tag);
} $tag, $tname;
}
return ($tname,'');
}
sub get_bitfield_type($) {
# nested bitfield handler
my ($tag) = @_;
check_bad_attrs($tag);
my $tname = decode_type_name_ref($tag, -force_type => 'bitfield-type');
unless ($tname) {
$tname = ensure_name undef;
with_anon {
render_bitfield_core($tname, $tag);
};
}
return ($tname,'');
}
sub get_enum_type($) {
# nested enum handler
my ($tag) = @_;
check_bad_attrs($tag);
my $tname = decode_type_name_ref($tag, -force_type => 'enum-type', -force_strong => 1);
my $base = get_primitive_base($tag, 'int32_t');
unless ($tname) {
$tname = ensure_name undef;
with_anon {
render_enum_core($tname,$tag);
};
}
return ("enum_field<$tname,$base>", '');
}
sub get_stl_vector_type($) {
# STL vector
my ($tag) = @_;
my $item = get_container_item_type($tag,1,'void*');
$item = 'char' if $item eq 'bool';
return ("std::vector<$item>", '');
}
sub get_stl_bit_vector_type($) {
# STL bit vector
my ($tag) = @_;
check_bad_attrs($tag);
return ("std::vector<bool>", '');
}
sub get_df_flagarray_type($) {
# DF flag array
my ($tag) = @_;
check_bad_attrs($tag);
my $type = decode_type_name_ref($tag, -attr_name => 'index-enum', -force_type => 'enum-type', -force_strong => 1) || 'int';
return ("BitArray<$type>", '');
}
# Struct dispatch table and core
%struct_field_handlers = (
'comment' => undef, # skip
'code-helper' => undef, # skip
'cond-if' => sub { die "cond handling error"; },
'cond-elseif' => sub { die "cond handling error"; },
'static-string' => \&get_static_string_type,
'padding' => \&get_padding_type,
'static-array' => \&get_static_array_type,
'pointer' => \&get_pointer_type,
'compound' => \&get_compound_type,
'bitfield' => \&get_bitfield_type,
'enum' => \&get_enum_type,
'stl-vector' => \&get_stl_vector_type,
'stl-bit-vector' => \&get_stl_bit_vector_type,
'df-flagarray' => \&get_df_flagarray_type,
);
$struct_field_handlers{$_} ||= \&get_primitive_field_type for @primitive_type_list;
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_struct_type {
my ($tag) = @_;
my $tag_name = $tag->nodeName;
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 {
render_struct_field($_) for get_struct_fields($tag);
use XML::LibXML;
use XML::LibXSLT;
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'),
");";
}
}
use Common;
outdent {
emit "protected:";
};
use Enum;
use Bitfield;
use StructType;
if ($is_class) {
emit "virtual ~",$typename,"() {}";
} else {
emit "~",$typename,"() {}";
}
}
} $tag, "$typename$ispec", -export => 1;
}
my $input_dir = $ARGV[0] || '.';
my $output_dir = $ARGV[1] || 'codegen';
# MAIN BODY
$main_namespace = $ARGV[2] || 'df';
$export_prefix = 'DFHACK_EXPORT ';
# Collect all type definitions from XML files
sub add_type_to_hash($) {
my ($type) = @_;
my $name = $type->getAttribute('type-name')
or die "Type without a name in $filename\n";
our $script_root;
my $parser = XML::LibXML->new();
my $xslt = XML::LibXSLT->new();
my @transforms =
map { $xslt->parse_stylesheet_file("$script_root/$_"); }
('lower-1.xslt', 'lower-2.xslt');
my @documents;
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;
}
for my $fn (glob "$input_dir/*.xml") {
for my $fn (sort { $a cmp $b } glob "$input_dir/*.xml") {
local $filename = $fn;
my $parser = XML::LibXML->new();
my $doc = $parser->parse_file($filename);
add_type_to_hash $_ foreach $doc->findnodes('/data-definition/enum-type');
add_type_to_hash $_ foreach $doc->findnodes('/data-definition/bitfield-type');
add_type_to_hash $_ foreach $doc->findnodes('/data-definition/struct-type');
add_type_to_hash $_ foreach $doc->findnodes('/data-definition/class-type');
my $doc = $parser->parse_file($filename);
$doc = $_->transform($doc) for @transforms;
push @documents, $doc;
add_type_to_hash $_ foreach $doc->findnodes('/ld:data-definition/ld:global-type');
}
# Generate text representations
@ -862,14 +64,16 @@ for my $name (sort { $a cmp $b } keys %types) {
eval {
my $type = $types{$typename};
my $meta = $type->getAttribute('ld:meta') or die "Null meta";
# Emit the actual type definition
my @code = with_emit {
with_anon {
$type_handlers{$type->nodeName}->($type);
my $handler = $type_handlers{$meta} or die "Unknown type meta: $meta\n";
$handler->($type);
};
} 2;
delete $weak_refs{$name};
delete $strong_refs{$name};
@ -919,6 +123,10 @@ mkdir $output_dir;
for my $name (glob "$output_dir/*.h") {
unlink $name;
}
for my $name (glob "$output_dir/*.inc") {
unlink $name;
}
unlink "$output_dir/codegen.out.xml";
# Write out the headers
local $, = "\n";
@ -932,13 +140,27 @@ mkdir $output_dir;
}
# Write out the static file
open FH, ">$output_dir/static.inc";
print FH "/* THIS FILE WAS GENERATED. DO NOT EDIT. */";
for my $name (sort { $a cmp $b } keys %static_includes) {
print FH "#include \"$name.h\"";
for my $tag (keys %static_lines) {
my $name = $output_dir.'/static'.($tag?'.'.$tag:'').'.inc';
open FH, ">$name";
print FH "/* THIS FILE WAS GENERATED. DO NOT EDIT. */";
for my $name (sort { $a cmp $b } keys %{$static_includes{$tag}}) {
print FH "#include \"$name.h\"";
}
print FH "namespace $main_namespace {";
print FH @{$static_lines{$tag}};
print FH '}';
close FH;
}
# Write an xml file with all types
open FH, ">$output_dir/codegen.out.xml";
print FH '<ld:data-definition xmlns:ld="http://github.com/peterix/dfhack/lowered-data-definition">';
for my $doc (@documents) {
for my $node ($doc->documentElement()->findnodes('*')) {
print FH ' '.$node->toString();
}
}
print FH "namespace $main_namespace {";
print FH @static_lines;
print FH '}';
print FH '</ld:data-definition>';
close FH;
}

@ -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 &lt; 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) &lt;= 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:
-->