diff --git a/src/dbHost/DBD.pm b/src/dbHost/DBD.pm
new file mode 100644
index 000000000..1cf82cc8a
--- /dev/null
+++ b/src/dbHost/DBD.pm
@@ -0,0 +1,57 @@
+package DBD;
+
+use DBD::Breaktable;
+use DBD::Device;
+use DBD::Driver;
+use DBD::Menu;
+use DBD::Recordtype;
+use DBD::Recfield;
+use DBD::Registrar;
+use DBD::Function;
+use DBD::Variable;
+
+sub new {
+        my $proto = shift;
+        my $class = ref($proto) || $proto;
+        my $this = {
+		BREAKTABLES => {},
+		DEVICES     => {},
+		DRIVERS     => {},
+		MENUS       => {},
+		RECORDTYPES => {},
+		REGISTRARS  => {},
+		FUNCTIONS   => {},
+		VARIABLES   => {}
+	};
+        bless $this, $class;
+	return $this;
+}
+
+sub add_breaktable {
+}
+
+sub add_driver {
+}
+
+sub add_menu {
+}
+
+sub add_recordtype {
+}
+
+sub add_registrar {
+}
+
+sub add_function {
+}
+
+sub add_variable {
+	my ($this, $obj) = @_;
+	confess "Not a DBD::Variable" unless $obj->isa('DBD::Variable');
+	my $obj_name = $obj->name;
+	dieContext("Duplicate variable '$obj_name'")
+		if exists $this->{VARIABLES}->{$obj_name};
+	$this->{VARIABLES}->{$obj_name} = $obj;
+}
+
+1;
diff --git a/src/dbHost/DBD/Breaktable.pm b/src/dbHost/DBD/Breaktable.pm
new file mode 100644
index 000000000..b36067aa1
--- /dev/null
+++ b/src/dbHost/DBD/Breaktable.pm
@@ -0,0 +1,32 @@
+package DBD::Breaktable;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+use Carp;
+
+sub init {
+	my ($this, $name) = @_;
+	$this->SUPER::init($name, "breakpoint table name");
+        $this->{POINTS} = [];
+        return $this;
+}
+
+sub add_point {
+	my ($this, $raw, $eng) = @_;
+	confess "Raw value undefined!" unless defined $raw;
+	$raw = unquote($raw);
+	confess "Engineering value undefined!" unless defined $eng;
+	$eng = unquote($eng);
+	push @{$this->{POINTS}}, [$raw, $eng];
+}
+
+sub points {
+	return @{shift->{POINTS}};
+}
+
+sub point {
+    my ($this, $idx) = @_;
+    return $this->{POINTS}[$idx];
+}
+
+1;
diff --git a/src/dbHost/DBD/Device.pm b/src/dbHost/DBD/Device.pm
new file mode 100644
index 000000000..c59d20f9f
--- /dev/null
+++ b/src/dbHost/DBD/Device.pm
@@ -0,0 +1,44 @@
+package DBD::Device;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+my %link_types = (
+	CONSTANT  => qr/$RXnum/o,
+	PV_LINK   => qr/$RXname \s+ [.NPCAMS ]*/ox,
+	VME_IO    => qr/\# (?: \s* [CS] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	CAMAC_IO  => qr/\# (?: \s* [BCNAF] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	RF_IO     => qr/\# (?: \s* [RMDE] \s* $RXdex)*/ox,
+	AB_IO     => qr/\# (?: \s* [LACS] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	GPIB_IO   => qr/\# (?: \s* [LA] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	BITBUS_IO => qr/\# (?: \s* [LNPS] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	BBGPIB_IO => qr/\# (?: \s* [LBG] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	VXI_IO    => qr/\# (?: \s* [VCS] \s* $RXdex)* \s* (?: @ .*)?/ox,
+	INST_IO   => qr/@.*/
+);
+
+sub init {
+	my ($this, $link_type, $dset, $choice) = @_;
+	dieContext("Unknown link type '$link_type', valid types are:",
+		sort keys %link_types) unless exists $link_types{$link_type};
+	$this->SUPER::init($dset, "DSET name");
+	$this->{LINK_TYPE} = $link_type;
+	$this->{CHOICE} = unquote($choice);
+	return $this;
+}
+
+sub link_type {
+	return shift->{LINK_TYPE};
+}
+
+sub choice {
+	return shift->{CHOICE};
+}
+
+sub legal_addr {
+	my $this = shift;
+	my $addr = unquote(shift);
+	my $rx = $link_types{$this->{LINK_TYPE}};
+	return $addr =~ m/^ $rx $/x;
+}
+
+1;
diff --git a/src/dbHost/DBD/Driver.pm b/src/dbHost/DBD/Driver.pm
new file mode 100644
index 000000000..8cee4d05e
--- /dev/null
+++ b/src/dbHost/DBD/Driver.pm
@@ -0,0 +1,9 @@
+package DBD::Driver;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+sub init {
+    return shift->SUPER::init(shift, "driver entry table name");
+}
+
+1;
diff --git a/src/dbHost/DBD/Function.pm b/src/dbHost/DBD/Function.pm
new file mode 100644
index 000000000..ce014b585
--- /dev/null
+++ b/src/dbHost/DBD/Function.pm
@@ -0,0 +1,9 @@
+package DBD::Function;
+@ISA = qw(DBD::Util);
+
+sub init {
+    return shift->SUPER::init(shift, "function name");
+}
+
+1;
+
diff --git a/src/dbHost/DBD/Menu.pm b/src/dbHost/DBD/Menu.pm
new file mode 100644
index 000000000..8ae4291ae
--- /dev/null
+++ b/src/dbHost/DBD/Menu.pm
@@ -0,0 +1,40 @@
+package DBD::Menu;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+sub init {
+    my ($this, $name) = @_;
+    $this->SUPER::init($name, "menu name");
+    $this->{CHOICES} = [];
+    $this->{CHOICE_INDEX} = {};
+    return $this;
+}
+
+sub add_choice {
+    my ($this, $name, $value) = @_;
+    $name = identifier($name, "Choice name");
+    $value = unquote($value, "Choice value");
+    foreach $pair ($this->choices) {
+    	dieContext("Duplicate choice name") if ($pair->[0] eq $name);
+    	dieContext("Duplicate choice string") if ($pair->[1] eq $value);
+    }
+    push @{$this->{CHOICES}}, [$name, $value];
+    $this->{CHOICE_INDEX}->{$value} = $name;
+}
+
+sub choices {
+    return @{shift->{CHOICES}};
+}
+
+sub choice {
+    my ($this, $idx) = @_;
+    return $this->{CHOICES}[$idx];
+}
+
+sub legal_choice {
+    my $this = shift;
+    my $value = unquote(shift);
+    return exists $this->{CHOICE_INDEX}->{$value};
+}
+
+1;
diff --git a/src/dbHost/DBD/Recfield.pm b/src/dbHost/DBD/Recfield.pm
new file mode 100644
index 000000000..81c0e410d
--- /dev/null
+++ b/src/dbHost/DBD/Recfield.pm
@@ -0,0 +1,96 @@
+package DBD::Recfield;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+# The hash value is a regexp that matches all legal values of this field
+our %field_types = (
+	DBF_STRING   => qr/.{0,40}/,
+	DBF_CHAR     => $RXint,
+	DBF_UCHAR    => $RXuint,
+	DBF_SHORT    => $RXint,
+	DBF_USHORT   => $RXuint,
+	DBF_LONG     => $RXint,
+	DBF_ULONG    => $RXuint,
+	DBF_FLOAT    => $RXnum,
+	DBF_DOUBLE   => $RXnum,
+	DBF_ENUM     => qr/.*/,
+	DBF_MENU     => qr/.*/,
+	DBF_DEVICE   => qr/.*/,
+	DBF_INLINK   => qr/.*/,
+	DBF_OUTLINK  => qr/.*/,
+	DBF_FWDLINK  => qr/.*/,
+	DBF_NOACCESS => qr//
+);
+
+# The hash value is a regexp that matches all legal values of this attribute
+our %field_attrs = (
+	asl         => qr/ASL[01]/,
+	initial     => qr/.*/,
+	promptgroup => qr/GUI_\w+/,
+	prompt      => qr/.*/,
+	special     => qr/(?:SPC_\w+|\d{3,})/,
+	pp          => qr/(?:YES|NO|TRUE|FALSE)/,
+	interest    => qr/\d+/,
+	base        => qr/(?:DECIMAL|HEX)/,
+	size        => qr/\d+/,
+	extra       => qr/.*/,
+	menu        => qr/$RXident/o
+);
+
+sub init {
+	my $this = shift;
+	my $name = shift;
+	my $type = unquote(shift);
+	$this->SUPER::init($name, "record field name");
+	exists $field_types{$type} or dieContext("Illegal field type '$type', ".
+		"valid field types are:", sort keys %field_types);
+	$this->{DBF_TYPE} = $type;
+	$this->{ATTRIBUTES} = {};
+	return $this;
+}
+
+sub dbf_type {
+	return shift->{DBF_TYPE};
+}
+
+sub add_attribute {
+	my $this = shift;
+	my $attr = shift;
+	my $value = unquote(shift);
+	dieContext("Unknown field attribute '$1', valid attributes are:",
+		   sort keys %field_attrs)
+		unless exists $field_attrs{$attr};
+	dieContext("Bad value '$value' for field '$attr' attribute")
+		unless $value =~ m/^ $field_attrs{$attr} $/x;
+	$this->{ATTRIBUTES}->{$attr} = $value;
+}
+
+sub attributes {
+	return shift->{ATTRIBUTES};
+}
+
+sub attribute {
+	my ($this, $attr) = @_;
+	return $this->attributes->{$attr};
+}
+
+sub legal_value {
+	my ($this, $value) = @_;
+	my $dbf_type = $this->dbf_type;
+	return $value =~ m/^ $field_types{$dbf_type} $/x;
+}
+
+sub check_valid {
+	# Internal validity checks of the field definition
+	my $this = shift;
+	my $name = $this->name;
+	my $default = $this->attribute("initial");
+	dieContext("Default value '$default' is invalid for field '$name'")
+		if (defined($default) and !$this->legal_value($default));
+	dieContext("Menu name not defined for field '$name'")
+		if ($this->dbf_type eq "DBF_MENU"
+		    and !defined($this->attribute("menu")));
+	# FIXME: Add more checks here?
+}
+
+1;
diff --git a/src/dbHost/DBD/Recordtype.pm b/src/dbHost/DBD/Recordtype.pm
new file mode 100644
index 000000000..c505395e6
--- /dev/null
+++ b/src/dbHost/DBD/Recordtype.pm
@@ -0,0 +1,75 @@
+package DBD::Recordtype;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+use Carp;
+
+sub init {
+	my $this = shift;
+	$this->SUPER::init(@_);
+        $this->{FIELDS} = [];		# Ordered list
+	$this->{FIELD_INDEX} = {};	# Indexed by name
+	$this->{DEVICES} = [];		# Ordered list
+	$this->{DEVICE_INDEX} = {};	# Indexed by choice
+        return $this;
+}
+
+sub add_field {
+	my ($this, $field) = @_;
+	confess "Not a DBD::Recfield" unless $field->isa('DBD::Recfield');
+	my $field_name = $field->name;
+	dieContext("Duplicate field name '$field_name'")
+		if exists $this->{FIELD_INDEX}->{$field_name};
+	$field->check_valid;
+	push $this->{FIELDS}, $field;
+	$this->{FIELD_INDEX}->{$field_name} = $field;
+}
+
+sub fields {
+	return shift->{FIELDS};
+}
+
+sub field_names { # In their original order...
+	my $this = shift;
+	my @names = ();
+	foreach ($this->fields) {
+		push @names, $_->name
+	}
+	return @names;
+}
+
+sub field {
+	my ($this, $field) = @_;
+	return $this->{FIELD_INDEX}->{$field};
+}
+
+sub add_device {
+	my ($this, $device) = @_;
+	confess "Not a DBD::Device" unless $device->isa('DBD::Device');
+	my $choice = $device->choice;
+	if (exists $this->{DEVICE_INDEX}->{$choice}) {
+		my @warning = ("Duplicate device type '$choice'");
+		my $old = $this->{DEVICE_INDEX}->{$choice};
+		push @warning, "Link types differ"
+			if ($old->link_type ne $device->link_type);
+		push @warning, "DSETs differ"
+			if ($old->name ne $device->name);
+		warnContext @warning;
+		return;
+	}
+	$device->check_valid;
+	push $this->{DEVICES}, $device;
+	$this->{DEVICE_INDEX}->{$choice} = $device;
+}
+
+sub devices {
+	my $this = shift;
+	return $this->{DEVICES};
+}
+
+sub device {
+	my ($this, $choice) = @_;
+	return $this->{DEVICE_INDEX}->{$choice};
+}
+
+1;
diff --git a/src/dbHost/DBD/Registrar.pm b/src/dbHost/DBD/Registrar.pm
new file mode 100644
index 000000000..0eefb98fd
--- /dev/null
+++ b/src/dbHost/DBD/Registrar.pm
@@ -0,0 +1,10 @@
+package DBD::Registrar;
+@ISA = qw(DBD::Util);
+
+sub init {
+    return shift->SUPER::init(shift, "registrar function name");
+}
+
+
+1;
+
diff --git a/src/dbHost/DBD/Util.pm b/src/dbHost/DBD/Util.pm
new file mode 100644
index 000000000..54ee6e435
--- /dev/null
+++ b/src/dbHost/DBD/Util.pm
@@ -0,0 +1,85 @@
+package DBD::Util;
+
+use Carp;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&pushContext &popContext &dieContext &identifier &unquote
+	$RXident $RXname $RXuint $RXint $RXdex $RXnum $RXdqs $RXsqs $RXstr);
+
+
+our $RXident = qr/[a-zA-Z][a-zA-Z0-9_]*/;
+our $RXname = qr/[a-zA-Z0-9_\-:.<>;]+/;
+our $RXhex = qr/ (?: 0 [xX] [0-9A-Fa-f]+ ) /x;
+our $RXuint = qr/ \d+ /x;
+our $RXint = qr/ -? $RXuint /ox;
+our $RXdex = qr/ ( $RXhex | $RXuint ) /x;
+our $RXnum = qr/-? (?: \d+ ) | (?: \d* \. \d+ ) (?: [eE] [-+]? \d+ )?/x;
+our $RXdqs = qr/" (?: [^"] | \\" )* "/x;
+our $RXsqs = qr/' (?: [^'] | \\' )* '/x;
+our $RXstr = qr/ ( $RXname | $RXnum | $RXdqs | $RXsqs ) /ox;
+
+
+our @context;
+
+sub pushContext {
+    my ($ctxt) = @_;
+    unshift @context, $ctxt;
+}
+
+sub popContext {
+    my ($ctxt) = @_;
+    my ($pop) = shift @context;
+    ($ctxt ne $pop) and
+	dieContext("Exiting context \"$ctxt\", found \"$pop\" instead.",
+	    "\tBraces must close in the same file they were opened.");
+}
+
+sub dieContext {
+    my ($msg) = join "\n\t", @_;
+    print "$msg\n" if $msg;
+    die "Context: ", join(' in ', @context), "\n";
+}
+
+sub warnContext {
+    my ($msg) = join "\n\t", @_;
+    print "$msg\n" if $msg;
+    print "Context: ", join(' in ', @context), "\n";
+}
+
+sub unquote {
+    my ($string) = @_;
+    $string =~ m/^"(.*)"$/o and $string = $1;
+    return $string;
+}
+
+sub identifier {
+    my $id = unquote(shift);
+    my $what = shift;
+    confess "$what undefined!" unless defined $id;
+    $id =~ m/^$RXident$/o or dieContext("Illegal $what '$id'",
+	"Identifiers are used in C code so must start with a letter, followed",
+	"by letters, digits and/or underscore characters only.");
+    return $id;
+}
+
+sub new {
+        my $proto = shift;
+        my $class = ref($proto) || $proto;
+        my $this = {};
+        bless $this, $class;
+	return $this->init(@_);
+}
+
+sub init {
+	my ($this, $name, $what) = @_;
+	$this->{NAME} = identifier($name, $what);
+	return $this;
+}
+
+sub name {
+	return shift->{NAME};
+}
+
+1;
diff --git a/src/dbHost/DBD/Variable.pm b/src/dbHost/DBD/Variable.pm
new file mode 100644
index 000000000..2791bb4ed
--- /dev/null
+++ b/src/dbHost/DBD/Variable.pm
@@ -0,0 +1,27 @@
+package DBD::Variable;
+use DBD::Util;
+@ISA = qw(DBD::Util);
+
+my %var_types = ("int" => 1, "double" => 1);
+
+sub init {
+    my ($this, $name, $type) = @_;
+    if (defined $type) {
+    	$type = unquote($type);
+    } else {
+	$type = "int";
+    }
+    exists $var_types{$type} or
+	dieContext("Unknown variable type '$type', valid types are:",
+	    sort keys %var_types);
+    $this->SUPER::init($name, "variable name");
+    $this->{VAR_TYPE} = $type;
+    return $this;
+}
+
+sub var_type {
+	my $this = shift;
+	return $this->{VAR_TYPE};
+}
+
+1;