#!/usr/bin/perl
# This little script generates various utilities and structures for proper
# and efficient method handler lookups.
use strict;
use warnings;
#the ordering here is important, and should be structured
#with the most common being first.. so in the average case only 1-3
#comparisons are ever needed
my @object_types = (
['string', '"' ],
['key', '#'],
['number', '=' ],
['object', '{'],
['list', '[' ],
['data', 'c' ],
['json', 'D' ],
['special', '^' ],
['boolean', '?' ],
['null', '~' ],
#this is a pseudo-type, and is manually picked up
['any', '.'],
);
my @mode_types = (
['on', '>'],
['start', '+'],
['end', '-'],
);
print <<"EOC";
/**
* This file was automatically generated by running the '$0'
* script. Do not modify this file directly.
*
* There are various macros in this header and they can be
* enabled within various sections of code by doing the following
*
* #define PLTUBA_METGHV_STRUCT
* #include "this_header_name"
* #undef PLTUBA_METHGV_STRUCT
*
* which will paste the definition of the methgv struct
*/
/** Structure defining GVs for all our callback methods */
#ifdef PLTUBA_METHGV_STRUCT
struct {
EOC
foreach (@mode_types) {
my $mode = $_->[0];
foreach (@object_types) {
my $oname = $_->[0];
print <<"EOC";
GV* $mode\_$oname;
EOC
}
}
print <<'EOC';
} methgv;
#endif /* PLTUBA_METHGV_STRUCT */
EOC
print <<"EOC";
/** X-Macro for method names */
#ifdef PLTUBA_DEFINE_XMETHGV
#define PLTUBA_XMETHGV \\
EOC
foreach (@mode_types) {
my $mode = $_->[0];
foreach (@object_types) {
my $obj = $_->[0];
print <<"EOC";
X($mode, $obj) \\
EOC
}
}
print <<"EOC";
#endif /* PLTUBA_DEFINE_XMETHGV */
EOC
print <<"EOC";
/**
* This generates a large switch statement which will
* return the proper method name and the pointer to the GV
* slot in the methgv structure. The reason why the pointer
* to the slot is returned (i.e. a GV** instead of a GV*) is
* so that it may be set and populated via a call to gv_fetchmethod
*/
#ifdef PLTUBA_METH_GETMETH
switch(action) {
EOC
foreach (@mode_types) {
my ($pl_mode,$c_mode) = @$_;
print <<"EOC";
/* $pl_mode */
case '$c_mode': {
switch(cbtype) {
EOC
foreach (@object_types) {
my ($pl_oname,$char) = @$_;
my $methname = "$pl_mode\_$pl_oname";
print <<"EOC";
case '$char':
/* $pl_oname */
methname = "$methname";
methgvp = &tuba->methgv.$methname;
break;
EOC
}
print <<"EOC";
default:
break;
}
break;
}
EOC
}
print <<"EOC";
default:
methname = NULL;
methgvp = NULL;
break;
}
#endif /* PLTUBA_METH_GETMETH */
EOC