[p5sagit/p5-mst-13.2.git] / ext / B / B / Stackobj.pm

#      Stackobj.pm
#
#      Copyright (c) 1996 Malcolm Beattie
#
#      You may distribute under the terms of either the GNU General Public
#      License or the Artistic License, as specified in the README file.
#
package B::Stackobj;  
use Exporter ();
@ISA = qw(Exporter);
@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT VALID_UNSIGNED
		VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
%EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
		flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
			     VALID_UNSIGNED REGISTER TEMPORARY)]);

use Carp qw(confess);
use strict;
use B qw(class SVf_IOK SVf_NOK SVf_IVisUV);

# Types
sub T_UNKNOWN () { 0 }
sub T_DOUBLE ()  { 1 }
sub T_INT ()     { 2 }
sub T_SPECIAL () { 3 }

# Flags
sub VALID_INT ()	{ 0x01 }
sub VALID_UNSIGNED ()	{ 0x02 }
sub VALID_DOUBLE ()	{ 0x04 }
sub VALID_SV ()		{ 0x08 }
sub REGISTER ()		{ 0x10 } # no implicit write-back when calling subs
sub TEMPORARY ()	{ 0x20 } # no implicit write-back needed at all
sub SAVE_INT () 	{ 0x40 } #if int part needs to be saved at all
sub SAVE_DOUBLE () 	{ 0x80 } #if double part needs to be saved at all


#
# Callback for runtime code generation
#
my $runtime_callback = sub { confess "set_callback not yet called" };
sub set_callback (&) { $runtime_callback = shift }
sub runtime { &$runtime_callback(@_) }

#
# Methods
#

sub write_back { confess "stack object does not implement write_back" }

sub invalidate { shift->{flags} &= ~(VALID_INT |VALID_UNSIGNED | VALID_DOUBLE) }

sub as_sv {
    my $obj = shift;
    if (!($obj->{flags} & VALID_SV)) {
	$obj->write_back;
	$obj->{flags} |= VALID_SV;
    }
    return $obj->{sv};
}

sub as_int {
    my $obj = shift;
    if (!($obj->{flags} & VALID_INT)) {
	$obj->load_int;
	$obj->{flags} |= VALID_INT|SAVE_INT;
    }
    return $obj->{iv};
}

sub as_double {
    my $obj = shift;
    if (!($obj->{flags} & VALID_DOUBLE)) {
	$obj->load_double;
	$obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
    }
    return $obj->{nv};
}

sub as_numeric {
    my $obj = shift;
    return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
}

sub as_bool {
	my $obj=shift;
	if ($obj->{flags} & VALID_INT ){
		return $obj->{iv}; 
	}
	if ($obj->{flags} & VALID_DOUBLE ){
		return $obj->{nv}; 
	}
	return sprintf("(SvTRUE(%s))", $obj->as_sv) ;
}

#
# Debugging methods
#
sub peek {
    my $obj = shift;
    my $type = $obj->{type};
    my $flags = $obj->{flags};
    my @flags;
    if ($type == T_UNKNOWN) {
	$type = "T_UNKNOWN";
    } elsif ($type == T_INT) {
	$type = "T_INT";
    } elsif ($type == T_DOUBLE) {
	$type = "T_DOUBLE";
    } else {
	$type = "(illegal type $type)";
    }
    push(@flags, "VALID_INT") if $flags & VALID_INT;
    push(@flags, "VALID_DOUBLE") if $flags & VALID_DOUBLE;
    push(@flags, "VALID_SV") if $flags & VALID_SV;
    push(@flags, "REGISTER") if $flags & REGISTER;
    push(@flags, "TEMPORARY") if $flags & TEMPORARY;
    @flags = ("none") unless @flags;
    return sprintf("%s type=$type flags=%s sv=$obj->{sv}",
		   class($obj), join("|", @flags));
}

sub minipeek {
    my $obj = shift;
    my $type = $obj->{type};
    my $flags = $obj->{flags};
    if ($type == T_INT || $flags & VALID_INT) {
	return $obj->{iv};
    } elsif ($type == T_DOUBLE || $flags & VALID_DOUBLE) {
	return $obj->{nv};
    } else {
	return $obj->{sv};
    }
}

#
# Caller needs to ensure that set_int, set_double,
# set_numeric and set_sv are only invoked on legal lvalues.
#
sub set_int {
    my ($obj, $expr,$unsigned) = @_;
    runtime("$obj->{iv} = $expr;");
    $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
    $obj->{flags} |= VALID_INT|SAVE_INT;
    $obj->{flags} |= VALID_UNSIGNED if $unsigned; 
}

sub set_double {
    my ($obj, $expr) = @_;
    runtime("$obj->{nv} = $expr;");
    $obj->{flags} &= ~(VALID_SV | VALID_INT);
    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
}

sub set_numeric {
    my ($obj, $expr) = @_;
    if ($obj->{type} == T_INT) {
	$obj->set_int($expr);
    } else {
	$obj->set_double($expr);
    }
}

sub set_sv {
    my ($obj, $expr) = @_;
    runtime("SvSetSV($obj->{sv}, $expr);");
    $obj->invalidate;
    $obj->{flags} |= VALID_SV;
}

#
# Stackobj::Padsv
#

@B::Stackobj::Padsv::ISA = 'B::Stackobj';
sub B::Stackobj::Padsv::new {
    my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
    $extra_flags |= SAVE_INT if $extra_flags & VALID_INT;
    $extra_flags |= SAVE_DOUBLE if $extra_flags & VALID_DOUBLE;
    bless {
	type => $type,
	flags => VALID_SV | $extra_flags,
	sv => "PL_curpad[$ix]",
	iv => "$iname",
	nv => "$dname"
    }, $class;
}

sub B::Stackobj::Padsv::load_int {
    my $obj = shift;
    if ($obj->{flags} & VALID_DOUBLE) {
	runtime("$obj->{iv} = $obj->{nv};");
    } else {
	runtime("$obj->{iv} = SvIV($obj->{sv});");
    }
    $obj->{flags} |= VALID_INT|SAVE_INT;
}

sub B::Stackobj::Padsv::load_double {
    my $obj = shift;
    $obj->write_back;
    runtime("$obj->{nv} = SvNV($obj->{sv});");
    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
}
sub B::Stackobj::Padsv::save_int {
    my $obj = shift;
    return $obj->{flags} & SAVE_INT;
}

sub B::Stackobj::Padsv::save_double {
    my $obj = shift;
    return $obj->{flags} & SAVE_DOUBLE;
}

sub B::Stackobj::Padsv::write_back {
    my $obj = shift;
    my $flags = $obj->{flags};
    return if $flags & VALID_SV;
    if ($flags & VALID_INT) {
        if ($flags & VALID_UNSIGNED ){
            runtime("sv_setuv($obj->{sv}, $obj->{iv});");
        }else{
            runtime("sv_setiv($obj->{sv}, $obj->{iv});");
        }     
    } elsif ($flags & VALID_DOUBLE) {
	runtime("sv_setnv($obj->{sv}, $obj->{nv});");
    } else {
	confess "write_back failed for lexical @{[$obj->peek]}\n";
    }
    $obj->{flags} |= VALID_SV;
}

#
# Stackobj::Const
#

@B::Stackobj::Const::ISA = 'B::Stackobj';
sub B::Stackobj::Const::new {
    my ($class, $sv) = @_;
    my $obj = bless {
	flags => 0,
	sv => $sv    # holds the SV object until write_back happens
    }, $class;
    if ( ref($sv) eq  "B::SPECIAL" ){
	$obj->{type}= T_SPECIAL;	
    }else{
    	my $svflags = $sv->FLAGS;
    	if ($svflags & SVf_IOK) {
		$obj->{flags} = VALID_INT|VALID_DOUBLE;
		$obj->{type} = T_INT;
                if ($svflags & SVf_IVisUV){
                    $obj->{flags} |= VALID_UNSIGNED;
                    $obj->{nv} = $obj->{iv} = $sv->UVX;
                }else{
                    $obj->{nv} = $obj->{iv} = $sv->IV;
                }
    	} elsif ($svflags & SVf_NOK) {
		$obj->{flags} = VALID_INT|VALID_DOUBLE;
		$obj->{type} = T_DOUBLE;
		$obj->{iv} = $obj->{nv} = $sv->NV;
    	} else {
		$obj->{type} = T_UNKNOWN;
    	}
    }
    return $obj;
}

sub B::Stackobj::Const::write_back {
    my $obj = shift;
    return if $obj->{flags} & VALID_SV;
    # Save the SV object and replace $obj->{sv} by its C source code name
    $obj->{sv} = $obj->{sv}->save;
    $obj->{flags} |= VALID_SV|VALID_INT|VALID_DOUBLE;
}

sub B::Stackobj::Const::load_int {
    my $obj = shift;
    if (ref($obj->{sv}) eq "B::RV"){
       $obj->{iv} = int($obj->{sv}->RV->PV);
    }else{
       $obj->{iv} = int($obj->{sv}->PV);
    }
    $obj->{flags} |= VALID_INT;
}

sub B::Stackobj::Const::load_double {
    my $obj = shift;
    if (ref($obj->{sv}) eq "B::RV"){
        $obj->{nv} = $obj->{sv}->RV->PV + 0.0;
    }else{
        $obj->{nv} = $obj->{sv}->PV + 0.0;
    }
    $obj->{flags} |= VALID_DOUBLE;
}

sub B::Stackobj::Const::invalidate {}

#
# Stackobj::Bool
#

@B::Stackobj::Bool::ISA = 'B::Stackobj';
sub B::Stackobj::Bool::new {
    my ($class, $preg) = @_;
    my $obj = bless {
	type => T_INT,
	flags => VALID_INT|VALID_DOUBLE,
	iv => $$preg,
	nv => $$preg,
	preg => $preg		# this holds our ref to the pseudo-reg
    }, $class;
    return $obj;
}

sub B::Stackobj::Bool::write_back {
    my $obj = shift;
    return if $obj->{flags} & VALID_SV;
    $obj->{sv} = "($obj->{iv} ? &PL_sv_yes : &PL_sv_no)";
    $obj->{flags} |= VALID_SV;
}

# XXX Might want to handle as_double/set_double/load_double?

sub B::Stackobj::Bool::invalidate {}

1;

__END__

=head1 NAME

B::Stackobj - Helper module for CC backend

=head1 SYNOPSIS

	use B::Stackobj;

=head1 DESCRIPTION

See F<ext/B/README>.

=head1 AUTHOR

Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>

=cut
Commit	Line	Data
a798dbf2	1	# Stackobj.pm
	2	#
	3	# Copyright (c) 1996 Malcolm Beattie
	4	#
	5	# You may distribute under the terms of either the GNU General Public
	6	# License or the Artistic License, as specified in the README file.
	7	#
4c1f658f	8	package B::Stackobj;
a798dbf2	9	use Exporter ();
a798dbf2	10	@ISA = qw(Exporter);
0ca04487	11	@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT VALID_UNSIGNED
a798dbf2	12	VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
	13	%EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
	14	flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
0ca04487	15	VALID_UNSIGNED REGISTER TEMPORARY)]);
a798dbf2	16
	17	use Carp qw(confess);
	18	use strict;
0ca04487	19	use B qw(class SVf_IOK SVf_NOK SVf_IVisUV);
a798dbf2	20
	21	# Types
	22	sub T_UNKNOWN () { 0 }
	23	sub T_DOUBLE () { 1 }
	24	sub T_INT () { 2 }
73544139	25	sub T_SPECIAL () { 3 }
a798dbf2	26
	27	# Flags
	28	sub VALID_INT () { 0x01 }
0ca04487	29	sub VALID_UNSIGNED () { 0x02 }
	30	sub VALID_DOUBLE () { 0x04 }
	31	sub VALID_SV () { 0x08 }
	32	sub REGISTER () { 0x10 } # no implicit write-back when calling subs
	33	sub TEMPORARY () { 0x20 } # no implicit write-back needed at all
	34	sub SAVE_INT () { 0x40 } #if int part needs to be saved at all
	35	sub SAVE_DOUBLE () { 0x80 } #if double part needs to be saved at all
8bac7e00	36
a798dbf2	37
	38	#
	39	# Callback for runtime code generation
	40	#
	41	my $runtime_callback = sub { confess "set_callback not yet called" };
	42	sub set_callback (&) { $runtime_callback = shift }
	43	sub runtime { &$runtime_callback(@_) }
	44
	45	#
	46	# Methods
	47	#
	48
	49	sub write_back { confess "stack object does not implement write_back" }
	50
0ca04487	51	sub invalidate { shift->{flags} &= ~(VALID_INT \|VALID_UNSIGNED \| VALID_DOUBLE) }
a798dbf2	52
	53	sub as_sv {
	54	my $obj = shift;
	55	if (!($obj->{flags} & VALID_SV)) {
	56	$obj->write_back;
	57	$obj->{flags} \|= VALID_SV;
	58	}
	59	return $obj->{sv};
	60	}
	61
	62	sub as_int {
	63	my $obj = shift;
	64	if (!($obj->{flags} & VALID_INT)) {
	65	$obj->load_int;
8bac7e00	66	$obj->{flags} \|= VALID_INT\|SAVE_INT;
a798dbf2	67	}
	68	return $obj->{iv};
	69	}
	70
	71	sub as_double {
	72	my $obj = shift;
	73	if (!($obj->{flags} & VALID_DOUBLE)) {
	74	$obj->load_double;
8bac7e00	75	$obj->{flags} \|= VALID_DOUBLE\|SAVE_DOUBLE;
a798dbf2	76	}
	77	return $obj->{nv};
	78	}
	79
	80	sub as_numeric {
	81	my $obj = shift;
	82	return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
	83	}
	84
a9b6343a	85	sub as_bool {
	86	my $obj=shift;
	87	if ($obj->{flags} & VALID_INT ){
	88	return $obj->{iv};
	89	}
	90	if ($obj->{flags} & VALID_DOUBLE ){
	91	return $obj->{nv};
	92	}
	93	return sprintf("(SvTRUE(%s))", $obj->as_sv) ;
	94	}
73544139	95
a798dbf2	96	#
	97	# Debugging methods
	98	#
	99	sub peek {
	100	my $obj = shift;
	101	my $type = $obj->{type};
	102	my $flags = $obj->{flags};
	103	my @flags;
	104	if ($type == T_UNKNOWN) {
	105	$type = "T_UNKNOWN";
	106	} elsif ($type == T_INT) {
	107	$type = "T_INT";
	108	} elsif ($type == T_DOUBLE) {
	109	$type = "T_DOUBLE";
	110	} else {
	111	$type = "(illegal type $type)";
	112	}
	113	push(@flags, "VALID_INT") if $flags & VALID_INT;
	114	push(@flags, "VALID_DOUBLE") if $flags & VALID_DOUBLE;
	115	push(@flags, "VALID_SV") if $flags & VALID_SV;
	116	push(@flags, "REGISTER") if $flags & REGISTER;
	117	push(@flags, "TEMPORARY") if $flags & TEMPORARY;
	118	@flags = ("none") unless @flags;
	119	return sprintf("%s type=$type flags=%s sv=$obj->{sv}",
	120	class($obj), join("\|", @flags));
	121	}
	122
	123	sub minipeek {
	124	my $obj = shift;
	125	my $type = $obj->{type};
	126	my $flags = $obj->{flags};
	127	if ($type == T_INT \|\| $flags & VALID_INT) {
	128	return $obj->{iv};
	129	} elsif ($type == T_DOUBLE \|\| $flags & VALID_DOUBLE) {
	130	return $obj->{nv};
	131	} else {
	132	return $obj->{sv};
	133	}
	134	}
	135
	136	#
	137	# Caller needs to ensure that set_int, set_double,
	138	# set_numeric and set_sv are only invoked on legal lvalues.
	139	#
	140	sub set_int {
0ca04487	141	my ($obj, $expr,$unsigned) = @_;
a798dbf2	142	runtime("$obj->{iv} = $expr;");
a798dbf2	143	$obj->{flags} &= ~(VALID_SV \| VALID_DOUBLE);
8bac7e00	144	$obj->{flags} \|= VALID_INT\|SAVE_INT;
0ca04487	145	$obj->{flags} \|= VALID_UNSIGNED if $unsigned;
a798dbf2	146	}
	147
	148	sub set_double {
	149	my ($obj, $expr) = @_;
	150	runtime("$obj->{nv} = $expr;");
	151	$obj->{flags} &= ~(VALID_SV \| VALID_INT);
8bac7e00	152	$obj->{flags} \|= VALID_DOUBLE\|SAVE_DOUBLE;
a798dbf2	153	}
	154
	155	sub set_numeric {
	156	my ($obj, $expr) = @_;
	157	if ($obj->{type} == T_INT) {
	158	$obj->set_int($expr);
	159	} else {
	160	$obj->set_double($expr);
	161	}
	162	}
	163
	164	sub set_sv {
	165	my ($obj, $expr) = @_;
	166	runtime("SvSetSV($obj->{sv}, $expr);");
	167	$obj->invalidate;
	168	$obj->{flags} \|= VALID_SV;
	169	}
	170
	171	#
	172	# Stackobj::Padsv
	173	#
	174
	175	@B::Stackobj::Padsv::ISA = 'B::Stackobj';
	176	sub B::Stackobj::Padsv::new {
	177	my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
8bac7e00	178	$extra_flags \|= SAVE_INT if $extra_flags & VALID_INT;
8bac7e00	179	$extra_flags \|= SAVE_DOUBLE if $extra_flags & VALID_DOUBLE;
a798dbf2	180	bless {
	181	type => $type,
	182	flags => VALID_SV \| $extra_flags,
81009501	183	sv => "PL_curpad[$ix]",
a798dbf2	184	iv => "$iname",
	185	nv => "$dname"
	186	}, $class;
	187	}
	188
	189	sub B::Stackobj::Padsv::load_int {
	190	my $obj = shift;
	191	if ($obj->{flags} & VALID_DOUBLE) {
	192	runtime("$obj->{iv} = $obj->{nv};");
	193	} else {
	194	runtime("$obj->{iv} = SvIV($obj->{sv});");
	195	}
8bac7e00	196	$obj->{flags} \|= VALID_INT\|SAVE_INT;
a798dbf2	197	}
	198
	199	sub B::Stackobj::Padsv::load_double {
	200	my $obj = shift;
	201	$obj->write_back;
	202	runtime("$obj->{nv} = SvNV($obj->{sv});");
8bac7e00	203	$obj->{flags} \|= VALID_DOUBLE\|SAVE_DOUBLE;
	204	}
	205	sub B::Stackobj::Padsv::save_int {
	206	my $obj = shift;
	207	return $obj->{flags} & SAVE_INT;
	208	}
	209
	210	sub B::Stackobj::Padsv::save_double {
	211	my $obj = shift;
	212	return $obj->{flags} & SAVE_DOUBLE;
a798dbf2	213	}
	214
	215	sub B::Stackobj::Padsv::write_back {
	216	my $obj = shift;
	217	my $flags = $obj->{flags};
	218	return if $flags & VALID_SV;
	219	if ($flags & VALID_INT) {
0ca04487	220	if ($flags & VALID_UNSIGNED ){
	221	runtime("sv_setuv($obj->{sv}, $obj->{iv});");
	222	}else{
	223	runtime("sv_setiv($obj->{sv}, $obj->{iv});");
	224	}
a798dbf2	225	} elsif ($flags & VALID_DOUBLE) {
	226	runtime("sv_setnv($obj->{sv}, $obj->{nv});");
	227	} else {
	228	confess "write_back failed for lexical @{[$obj->peek]}\n";
	229	}
	230	$obj->{flags} \|= VALID_SV;
	231	}
	232
	233	#
	234	# Stackobj::Const
	235	#
	236
	237	@B::Stackobj::Const::ISA = 'B::Stackobj';
	238	sub B::Stackobj::Const::new {
	239	my ($class, $sv) = @_;
	240	my $obj = bless {
	241	flags => 0,
	242	sv => $sv # holds the SV object until write_back happens
	243	}, $class;
73544139	244	if ( ref($sv) eq "B::SPECIAL" ){
	245	$obj->{type}= T_SPECIAL;
	246	}else{
	247	my $svflags = $sv->FLAGS;
	248	if ($svflags & SVf_IOK) {
	249	$obj->{flags} = VALID_INT\|VALID_DOUBLE;
	250	$obj->{type} = T_INT;
0ca04487	251	if ($svflags & SVf_IVisUV){
	252	$obj->{flags} \|= VALID_UNSIGNED;
	253	$obj->{nv} = $obj->{iv} = $sv->UVX;
	254	}else{
	255	$obj->{nv} = $obj->{iv} = $sv->IV;
	256	}
73544139	257	} elsif ($svflags & SVf_NOK) {
	258	$obj->{flags} = VALID_INT\|VALID_DOUBLE;
	259	$obj->{type} = T_DOUBLE;
	260	$obj->{iv} = $obj->{nv} = $sv->NV;
	261	} else {
	262	$obj->{type} = T_UNKNOWN;
	263	}
a798dbf2	264	}
	265	return $obj;
	266	}
	267
	268	sub B::Stackobj::Const::write_back {
	269	my $obj = shift;
	270	return if $obj->{flags} & VALID_SV;
	271	# Save the SV object and replace $obj->{sv} by its C source code name
	272	$obj->{sv} = $obj->{sv}->save;
	273	$obj->{flags} \|= VALID_SV\|VALID_INT\|VALID_DOUBLE;
	274	}
	275
	276	sub B::Stackobj::Const::load_int {
	277	my $obj = shift;
5ab5c7a4	278	if (ref($obj->{sv}) eq "B::RV"){
	279	$obj->{iv} = int($obj->{sv}->RV->PV);
	280	}else{
	281	$obj->{iv} = int($obj->{sv}->PV);
	282	}
a798dbf2	283	$obj->{flags} \|= VALID_INT;
	284	}
	285
	286	sub B::Stackobj::Const::load_double {
	287	my $obj = shift;
5ab5c7a4	288	if (ref($obj->{sv}) eq "B::RV"){
	289	$obj->{nv} = $obj->{sv}->RV->PV + 0.0;
	290	}else{
	291	$obj->{nv} = $obj->{sv}->PV + 0.0;
	292	}
a798dbf2	293	$obj->{flags} \|= VALID_DOUBLE;
	294	}
	295
	296	sub B::Stackobj::Const::invalidate {}
	297
	298	#
	299	# Stackobj::Bool
	300	#
	301
	302	@B::Stackobj::Bool::ISA = 'B::Stackobj';
	303	sub B::Stackobj::Bool::new {
	304	my ($class, $preg) = @_;
	305	my $obj = bless {
	306	type => T_INT,
	307	flags => VALID_INT\|VALID_DOUBLE,
	308	iv => $$preg,
	309	nv => $$preg,
	310	preg => $preg # this holds our ref to the pseudo-reg
	311	}, $class;
	312	return $obj;
	313	}
	314
	315	sub B::Stackobj::Bool::write_back {
	316	my $obj = shift;
	317	return if $obj->{flags} & VALID_SV;
81009501	318	$obj->{sv} = "($obj->{iv} ? &PL_sv_yes : &PL_sv_no)";
a798dbf2	319	$obj->{flags} \|= VALID_SV;
	320	}
	321
	322	# XXX Might want to handle as_double/set_double/load_double?
	323
	324	sub B::Stackobj::Bool::invalidate {}
	325
	326	1;
7f20e9dd	327
	328	__END__
	329
	330	=head1 NAME
	331
	332	B::Stackobj - Helper module for CC backend
	333
	334	=head1 SYNOPSIS
	335
	336	use B::Stackobj;
	337
	338	=head1 DESCRIPTION
	339
	340	See F<ext/B/README>.
	341
	342	=head1 AUTHOR
	343
	344	Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
	345
	346	=cut