#!perl -w
use 5.008_001;
use strict;
sub code {
my($code) = @_;
$code =~ s/^\#//xmsg;
return $code;
}
sub say {
print @_, "\n";
}
binmode STDOUT;
my @ops;
print code <<"HEAD";
#/* This file is automatically generated by $0.
# * ANY CHANGES WILL BE LOST!
# */
#
HEAD
say "/* forward decl for Xslate opcodes */";
while(<>) {
if(/^TXC(\w*) \s* \( (\w+) \)/xms) {
push @ops, [$2, $1];
s/\s*\{/;/;
print;
}
}
print code <<'H';
#
#enum tx_opcode_t {
H
for(my $i = 0; $i < @ops; $i++) {
say " TXOP_$ops[$i][0], /* $i */";
}
print code <<'H';
# TXOP_last
#}; /* enum tx_opcode_t */
H
print code <<'H';
#
#static const U8 tx_oparg[] = {
H
for(my $i = 0; $i < @ops; $i++) {
my $arg_type = $ops[$i][1];
my $flags;
if($arg_type) {
$flags .= "TXCODE" . uc $arg_type;
}
else {
$flags = '0U';
}
say " $flags, /* $ops[$i][0] */";
}
print code <<'H';
#}; /* tx_oparg[] */
#
#static void
#tx_init_ops(pTHX_ HV* const ops) {
H
for(my $i = 0; $i < @ops; $i++) {
say " (void)hv_stores(ops, STRINGIFY($ops[$i][0]), newSViv(TXOP_$ops[$i][0]));";
}
print code <<'H';
#} /* tx_register_ops() */
H
print code <<'H';
#
##ifndef TX_DIRECT_THREADED_CODE
##define dTX_optable dNOOP
#static const tx_exec_t tx_optable[] = {
H
for(my $i = 0; $i < @ops; $i++) {
say " TXCODE_$ops[$i][0],";
}
print code <<'H';
# NULL
#}; /* tx_optable[] */
H
print code <<'H';
#
##else /* TX_DIRECT_THREADED_CODE */
##define dTX_optable void const* const* const tx_optable \
# = tx_runops(aTHX_ NULL)
##define LABEL(x) CAT2(TX_DTC_, x)
##define LABEL_PTR(x) &&LABEL(x)
#static void const* const*
#tx_runops(pTHX_ tx_state_t* const st) {
# static const void* const ops_address_table[] = {
H
pop @ops; # "end"
foreach my $op(@ops) {
say " LABEL_PTR($op->[0]),";
}
print code <<'H';
# LABEL_PTR(end)
# }; /* end of ops_address_table */
# if(UNLIKELY(st == NULL)) {
# return ops_address_table;
# }
#
# goto *(st->pc->exec_code); /* start */
#
# /* dispatch */
H
foreach my $op(@ops) {
print code sprintf <<'H', @{$op};
# LABEL(%1$-20s): TXCODE_%1$-20s(aTHX_ st); goto *(st->pc->exec_code);
H
}
print code << 'H';
# LABEL(end): TXCODE_end(aTHX_ st);
# return NULL;
#} /* end of tx_runops() */
##undef LABEL
##undef LABEL_PTR
##endif /* TX_DIRECT_THREADED_CODE */
H