diff --git a/Memory.xml b/Memory.xml
index b4f7ce1f3..b12039c14 100644
--- a/Memory.xml
+++ b/Memory.xml
@@ -1078,6 +1078,8 @@
+
+
@@ -2316,6 +2318,8 @@
+
+
@@ -3188,6 +3192,8 @@
+
+
diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt
index 9a87db9af..e55a130dd 100644
--- a/library/CMakeLists.txt
+++ b/library/CMakeLists.txt
@@ -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)
diff --git a/library/Core.cpp b/library/Core.cpp
index 5296a057e..1482aac82 100644
--- a/library/Core.cpp
+++ b/library/Core.cpp
@@ -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
diff --git a/library/DataDefs.cpp b/library/DataDefs.cpp
index 2f1f9c238..0693459ed 100644
--- a/library/DataDefs.cpp
+++ b/library/DataDefs.cpp
@@ -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) \
diff --git a/library/DataStatics.cpp b/library/DataStatics.cpp
index e3a448eac..28a4de0f8 100644
--- a/library/DataStatics.cpp
+++ b/library/DataStatics.cpp
@@ -15,3 +15,4 @@ namespace {
// Instantiate all the static objects
#include "dfhack/df/static.inc"
+#include "dfhack/df/static.enums.inc"
diff --git a/library/DataStaticsCtor.cpp b/library/DataStaticsCtor.cpp
new file mode 100644
index 000000000..edd3092fb
--- /dev/null
+++ b/library/DataStaticsCtor.cpp
@@ -0,0 +1,6 @@
+#include "Internal.h"
+#include "dfhack/DataDefs.h"
+#include "dfhack/MiscUtils.h"
+
+// Object constructors
+#include "dfhack/df/static.ctors.inc"
diff --git a/library/include/dfhack/DataDefs.h b/library/include/dfhack/DataDefs.h
index 4308ea3ed..02014a057 100644
--- a/library/include/dfhack/DataDefs.h
+++ b/library/include/dfhack/DataDefs.h
@@ -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 &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
@@ -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 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(virtual_identity::instantiate()); }
+ T *clone(T* obj) { return static_cast(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(tgt) = *static_cast(src); }
};
template
@@ -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) \
diff --git a/library/include/dfhack/df/.gitignore b/library/include/dfhack/df/.gitignore
index 11c5ffbb1..7cd9ae481 100644
--- a/library/include/dfhack/df/.gitignore
+++ b/library/include/dfhack/df/.gitignore
@@ -1,2 +1,3 @@
*.h
*.inc
+*.xml
diff --git a/library/xml/Bitfield.pm b/library/xml/Bitfield.pm
new file mode 100644
index 000000000..e85c7af68
--- /dev/null
+++ b/library/xml/Bitfield.pm
@@ -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;
diff --git a/library/xml/Common.pm b/library/xml/Common.pm
new file mode 100644
index 000000000..82835a6b6
--- /dev/null
+++ b/library/xml/Common.pm
@@ -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;
diff --git a/library/xml/Enum.pm b/library/xml/Enum.pm
new file mode 100644
index 000000000..7a22239c8
--- /dev/null
+++ b/library/xml/Enum.pm
@@ -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;
diff --git a/library/xml/StructFields.pm b/library/xml/StructFields.pm
new file mode 100644
index 000000000..8947ef4a6
--- /dev/null
+++ b/library/xml/StructFields.pm
@@ -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";
+ },
+ '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;
diff --git a/library/xml/StructType.pm b/library/xml/StructType.pm
new file mode 100644
index 000000000..bc5561d46
--- /dev/null
+++ b/library/xml/StructType.pm
@@ -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;
diff --git a/library/xml/codegen.pl b/library/xml/codegen.pl
index 05684732b..20c4a431f 100755
--- a/library/xml/codegen.pl
+++ b/library/xml/codegen.pl
@@ -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", '');
-}
-
-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 '';
+ 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 '';
close FH;
}
diff --git a/library/xml/lower-1.xslt b/library/xml/lower-1.xslt
new file mode 100644
index 000000000..8316a384f
--- /dev/null
+++ b/library/xml/lower-1.xslt
@@ -0,0 +1,289 @@
+
+
+
+
+
+
+
+
+
+
+
+
+ Error: Unexpected tag:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Error: Cannot refer to primitive types from
+
+
+
+
+
+
+
+
+ global
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ compound
+
+
+
+
+
+
+
+
+
+
+
+ true
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ true
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/library/xml/lower-2.xslt b/library/xml/lower-2.xslt
new file mode 100644
index 000000000..9bcd53f0a
--- /dev/null
+++ b/library/xml/lower-2.xslt
@@ -0,0 +1,78 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Unexpected field:
+
+
+
+
+
+ Unexpected method:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+