Hi there,
I have included a script that I think addresses TODO #32365 --
which was, in short, allow easy shortcuts to build information. The
script generates a file called parrot-config.pbc in the root directory
that can search through build information and shortcuts.
parrot parrot-config.pbc --dump # gives you all the build information
parrot parrot-config.pbc --shortcuts # describes all the shortcuts.
Having a build-* script to generate parrot-config is advantageous
because it allows easy addition of new shortcuts. It should be "easy"
to add new shortcuts that grok the build data in whatever way the user
wants. Also the build script allows all (actually most) shortcuts to be
frozen into .fpmc on disk with build information making quick lookup.
If this patch looks like it satisfies the constraints of TODO 32365, it
should probably be inserted in the main Makefile. Line 696 of that file reads
runtime/parrot/include/config.fpmc : myconfig config_lib.pasm $(TEST_PROG)
@echo Invoking Parrot to generate runtime/parrot/include/config.fpmc
--cross your fingers
./parrot config_lib.pasm
@echo If the next line prints $(VERSION), it did help.
./parrot parrot-config.imc VERSION DEVEL
Could be replaced with
runtime/parrot/include/parrot-config.fpmc : $(???SOME
DIRECTORY???)/build-parrot-config.pl
perl $(???SOME DIRECTORY???)/build-parrot-config.pl
@echo If the next line prints $(VERSION), it did help.
./parrot parrot-config.pbc VERSION DEVEL
One thing I didn't address is what kind of shortcuts folks want. I just
have a couple of example shortcuts in the script.
Let me know what needs to be done to make the script better/more inline
with what was requested in TODO #32365.
Best,Pete
ps: I've included it in this message in case people have a fear of
atmnts.
pss: The current file writes parrot-config-temp rather than
parrot-config so that one does not accidentally destroy parrot-config
during the test period.
===========================================================================
=head1 NAME
build-parrot-config.pl
=head1 SYNOPSIS
This script builds the file parrot-config.pbc in the root build
directory. parrot-config.pbc displays information that was obtained
during build process.
=head1 DESCRIPTION
parrot-config.pbc is a program to access build information from
the command line. The current script automatically generates
parrot-config.pbc. The auto-generation is useful because it allows
and easy, extendible way to add I<shortcuts> to build information.
For example, the build process produces two tags for build
information: B<cc_inc> and B<ld_share_flags> (this information is
obtained during the build process). So to obtain this information from
the command line one would write
$ parrot parrot-config.imc cc_inc ld_share_flags
But suppose one wanted (for whatever reason) to make a
shortcut to these two flags, one could define a shortcut called
B<--my-flag> that would print out the same data as would be printed
from the above command. Instead of above, we could write
$ parrot parrot-config.imc --my-flag
Defining shortcuts is straight forward. There is a hash named
%shortcut which contains all the shortcuts to be included in
parrot-config. An example is shown below
=begin text
my %shortcut = (
"--a", [[$TY_LIT,"SOME TEXT BABY"]],
"--b", shortcut_allkeys( qw{ cc_inc ld_share_flags } ),
"--c",
[[$TY_KEY,"cc_inc"],[$TY_LIT,"with-literal"],[$TY_KEY,"ld_share_flags"]],
"--dump", shortcut_code($dump_sub_code,"Dump all build values"),
"--shortcuts",shortcut_code($shortcut_sub_code,"Write all the shortcuts"),
"--usage",shortcut_code($usage_sub_code,"Write usage information")
);
=end text
We see that the value of shortcut is a list reference. The list may either
contain
=over 4
=item Literal and/or keys list
A list of pairs [TYPE,TEXT]. This is used to include I<literal>s verbatim or
I<keys> are looked up in the existing build data hash (PConfig). There is a
function
called C<shortcut_allkeys> which takes a list of literal keys and generates the
appropriate [$TY_KEY,TEXT] list.
=item Code segment
The result of a call to the subroutine shortcut_code(CODE-BODY,CODE-USAGE) where
CODE-BODY is the body of a parrot subroutine and CODE-USAGE is a one line
description
of the shortcut. The CODE-BODY is written like the normal body of a .pcc_sub
that
has been passed a hash called conf_hash -- which contains the contents of
PConfig and
%shortcut. See code for --dump or --shortcut below for example.
=back
One hopes that with literal,key and code types one can easily grok any
combination
of build data.
XXX The one addition would be to allow arguments to be passed at the command
line
to the subroutines. At some point though one has to worry about overkill :-).
Executing the script leaves only parrot-config.pbc in the root build directory.
See
the config variables below to leave various files in the build directory for
inspection.
parrot-config basically works by opening up a frozen pmc (generated by this
script)
and searching it for build data.
=head1 PROBLEMS
Lots of ugly HERE-DOCS are in this script.
=head1 SEE ALSO
Depends on F<lib/Parrot/Config.pm>.
Generates F<./parrot-config.pbc> and
F<runtime/parrot/include/parrot-config.fpmc>
=head1 AUTHORS
1/2005:
Pete Christopher wrote current script but stole loads of code from
config/gen/config_pm.pl (written by ??) and (the original code for)
parrot-config.imc (written by Leopold Toetsch)
=cut
#########################################
# CONFIGURATION VARIABLES:
# configures this script
#########################################
$this_script_name = 'build-parrot-config.pl';
$fpmc_location = 'runtime/parrot/include/parrot-config.fpmc';
$pconfig_location = 'lib/Parrot/Config.pm';
$output_basename = 'parrot-config-temp';
$leave_fpmc_script = 0; #leave the script that builds the fpmc in ROOT directory
$leave_config_imc_script = 0; #leave $output_basename.imc in ROOT directory
#########################################
# SUBROUTINE DEFS:
# defs for shortcut subroutines
#########################################
$dump_sub_code = <<EOF;
.local pmc iter
new iter, .Iterator, conf_hash
iter = .ITERATE_FROM_START
iter_loop:
unless iter goto iter_end
shift \$S0, iter
print \$S0
print " => '"
\$S1 = conf_hash[\$S0]
print \$S1
print "'\\n"
goto iter_loop
iter_end:
EOF
$shortcut_sub_code = <<EOF;
.local pmc iter
.local string dashdash,str_result
.local int string_type
.local pmc hash_result,undf
.local int hash_type
find_type string_type,"PerlString"
new iter, .Iterator, conf_hash
new undf,.Undef
iter = .ITERATE_FROM_START
dashdash = ""
iter_loop:
unless iter goto iter_end
shift \$S0, iter
length \$I0,\$S0
if \$I0 < 2 goto iter_loop
substr dashdash,\$S0,0,2
unless dashdash == "--" goto iter_loop
print \$S0
print " => "
hash_result = conf_hash[\$S0]
typeof hash_type,hash_result
if hash_type == string_type goto handle_string
str_result = hash_result(undf)
print "SUB: '"
print str_result
print "'"
goto bottom_hash_type_if
handle_string:
print "'"
print hash_result
print "'"
bottom_hash_type_if:
print "\\n"
goto iter_loop
iter_end:
EOF
$usage_sub_code = <<EOF;
print "parrot-config config-key [config-key, ....]\\n"
EOF
#######################################################
# PARROT_CONFIG BODY:
# contains most of the body of the parrot_config script
#######################################################
$parrot_config_script_body = <<EOF;
#+++++++++++++++++++++++++++++++++++++++
#THIS FILE MACHINE GENERATED FROM SCRIPT
# $this_script_name
# Don't modify this file
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
.include "iterator.pasm"
.sub _main [EMAIL PROTECTED]
.param pmc argv
.local int argc
.local pmc conf_hash
.local pmc hash_result
.local string key
.local int i,fail
.local int string_type,hash_type
#fetch the frozen pmc hash
conf_hash = _config()
argc = argv
if argc >= 2 goto argc_good
#call usage
hash_result = conf_hash["--usage"]
unless hash_result goto usage_botched
typeof hash_type,hash_result
find_type \$I0,"Sub"
unless hash_type == \$I0 goto usage_botched
hash_result(conf_hash)
exit 1
usage_botched:
printerr "INTERNAL ERROR: No --usage sub defined\\n"
printerr "Anyway you must have at least 2 args to this program\\n"
exit 1
argc_good:
#set string type
#XXX when a switch from PerlString String is made,
# must change this to "String"
find_type string_type,"PerlString"
# Check that the keys are defined
i = 1
fail = 0
loop1:
#do
key = argv[i]
\$I0 = defined conf_hash[key]
if \$I0 goto found1
print " no such key: '"
print key
print "'\\n"
set fail,1
found1:
inc i
if i < argc goto loop1
#endloop
if fail == 0 goto nofail
exit 1
nofail:
i = 1
loop2:
key = argv[i]
hash_result = conf_hash[key]
typeof hash_type,hash_result
if hash_type == string_type goto handle_string
hash_result(conf_hash)
goto bottom_loop2
handle_string:
print hash_result
bottom_loop2:
inc i
if i < argc goto loop2
print "\\n"
end
.end
.pcc_sub _config
.local pmc CONF
# XXX: this works only if parrot is run from its root directory
.const string conf_file = "$fpmc_location"
open CONF, conf_file, "<"
\$I0 = defined CONF
if \$I0 goto ok1
printerr "Can't read '"
printerr conf_file
printerr "': "
err \$S0
printerr \$S0
printerr "\\n"
exit 1
ok1:
.local string image
# If it gets above 64k, we've got bigger problems.
read image, CONF, 60000
close CONF
.local pmc conf_hash
thaw conf_hash, image
# XXX hash should probably be marked read-only...
#HERE WE GO AND FILL IN THE subs from the hash table
.local pmc glb
#START MACHINE GENERATED
<<ADD-SUBROUTINES-TO-HASH>>
#END MACHINE GENERATED
.pcc_begin_return
.return conf_hash
.pcc_end_return
miserable_fail:
printerr "Failed to find a subroutine: probably messed up\\n"
printerr "parrot-config-build.pl.\\n"
end
.end
#START MACHINE GENERATED
<<ADD-SUBROUTINE-BODIES>>
#END MACHINE GENERATED
EOF
##################################
# GENERATE FROZEN PMC SCRIPT BODY
##################################
$gen_frozen_pmc_script_body = <<EOF;
new P0, .PerlHash
new P1, .PerlUndef
<<HERE>>
# XXX: this works only if parrot is run from its root directory
open P1, "$fpmc_location", ">"
freeze S0, P0
print P1, S0
close P1
end
EOF
#########################################
# Define some (internal) global vars
#########################################
my ($TY_KEY,$TY_LIT,$TY_CODE) = (0,1,2);
my $code_data_shortcut = 0;
my %shortcut = (
"--a", [[$TY_LIT,"SOME TEXT BABY"]],
"--b", shortcut_allkeys( qw{ cc_inc ld_share_flags } ),
"--c",
[[$TY_KEY,"cc_inc"],[$TY_LIT,"with-literal"],[$TY_KEY,"ld_share_flags"]],
"--dump", shortcut_code($dump_sub_code,"Dump all build values"),
"--shortcuts",shortcut_code($shortcut_sub_code,"Write all the shortcuts"),
"--usage",shortcut_code($usage_sub_code,"Write usage information")
);
#########################################
# INTERNAL SUBS:
# Subs that do various things
#########################################
sub error_to_many_in_code {
my $flag = shift;
my $m = "Can only have one CODE object for flag $flag";
return $m;
}
#This just fetches the PConfig dump from Config.pm
#puts the result into global namespace.
#XXX probably more elegant way to do this, but
# I'm not very knowledgeable about perl.
sub fetch_PConfig {
my $fn = $pconfig_location;
my (@lines,$i,$j,$buffer);
open(IN,$fn) or die;
@lines = <IN>;
close(IN);
for($i=0; $i<$#lines; $i++){
$_ = $lines[$i];
last if /%PConfig = \(/;
}
$buffer = join('',@lines[$i .. $#lines]);
return eval $buffer;
}
sub proc_shortcut {
my $add_subs_to_hash = "";
my $next_sub_label = 0;
my $add_to_sub_def = "";
while( ($flag,$v) = each %shortcut ){
if($v->[0][0] == $TY_CODE){
#Handle code
die error_to_many_in_code($flag) unless @$v == 1;
my $sub_name = "_proc_shortcut_sub_" . $next_sub_label++;
my $code_body = $v->[0][1];
my $usage_line = $v->[0][2];
$add_subs_to_hash .= <<EOF;
find_global glb,"$sub_name"
unless glb,miserable_failiure
conf_hash["$flag"] = glb
EOF
$add_to_sub_def .= <<EOF;
.pcc_sub $sub_name
.param pmc conf_hash
.const string __usage_data = "$usage_line"
if conf_hash goto [EMAIL PROTECTED]
.return(__usage_data)
[EMAIL PROTECTED]:
$code_body
.return(S0) #don't use this value
.end
EOF
next;
}
#Ok must be a normal KEY,LIT list
my $buff = "";
for $e (@$v){
my $add;
my @elst = @$e;
if($elst[0] == $TY_KEY){
$add = $PConfig{$elst[1]};
die "Unkown key '$elst[1]' in shortcut" unless $add;
$buff .= " " . $add . " ";
}
elsif($elst[0] == $TY_LIT){
$add = $elst[1];
$buff .= " " . $add . " ";
}
elsif($elst[0] == $TY_CODE){
die error_to_many_in_code($flag) unless @$v == 1;
}
else {
die "Unhandled type in proc_shortcut";
}
}
$buff =~ s/[ ]+/ /g; #This could ass your $TY_LIT's, but I like single
spaces.
$PConfig{$flag} = $buff;
}
if($add_subs_to_hash){
$code_data_shortcut = [$add_subs_to_hash,$add_to_sub_def];
}
}
sub shortcut_code {
die "shortcut_code must have exaclty 2 args" unless @_ == 2;
my ($c,$u) = @_;
return [[$TY_CODE,$c,$u]];
}
sub shortcut_allkeys {
my $r = [];
for $s (@_){
push(@$r,[$TY_KEY,$s]);
}
return $r;
}
sub gen_frozen_pmc {
my ($k,$i,$buff);
my $random_name = $output_basename . "_fpmc_script.pasm";
my @gen_pmc_in = split(/\n/,$gen_frozen_pmc_script_body);
$buff = "";
for($i=0;$i<@gen_pmc_in; $i++){
$_ = $gen_pmc_in[$i];
if(/<<HERE>>/){
my @lst = sort { lc $a cmp lc $b || $a cmp $b } keys(%PConfig);
my $t = keys %PConfig;
for $k (@lst) {
my $v=$PConfig{$k};
if(defined $v) {
$v =~ s/(["\\])/\\$1/g; # "
$v =~ s/\n/\\n/g;
$buff .= qq(\tset P0["$k"], "$v"\n);
}
else {
$buff .= qq(\tset P0["$k"], P1\n);
}
}
}
else {
$buff .= $_ . "\n";
}
}
open(OUT,">" . $random_name) or die "Failed to open " . $random_name;
print OUT "$buff\n";
close(OUT);
system("parrot $random_name");
my $status = $?;
system("rm $random_name") unless $leave_fpmc_script;
die "Failed to compile parrot-config.fpmc" if $status != 0;
}
sub write_parrot_config {
open(OUT,">" . $output_basename . '.imc') or die;
if($code_data_shortcut){
my $add_subs_to_hash = $code_data_shortcut->[0];
my $add_to_sub_def = $code_data_shortcut->[1];
$parrot_config_script_body =~
s/<<ADD-SUBROUTINES-TO-HASH>>/$add_subs_to_hash/;
$parrot_config_script_body =~ s/<<ADD-SUBROUTINE-BODIES>>/$add_to_sub_def/;
}
else {
$parrot_config_script_body =~ s/<<ADD-SUBROUTINES-TO-HASH>>//;
$parrot_config_script_body =~ s/<<ADD-SUBROUTINE-BODIES>>//;
}
print OUT "$parrot_config_script_body\n";
close(OUT);
system("parrot -o $output_basename.pbc $output_basename.imc");
die "Failed to compile $output_basename.pbc" if $? != 0;
system("rm $output_basename.imc") unless $leave_config_imc_script;
}
sub main {
#go and fetch configuration data
fetch_PConfig();
proc_shortcut();
gen_frozen_pmc();
write_parrot_config();
}
#call main
main();
=head1 NAME
build-parrot-config.pl
=head1 SYNOPSIS
This script builds the file parrot-config.pbc in the root build
directory. parrot-config.pbc displays information that was obtained
during build process.
=head1 DESCRIPTION
parrot-config.pbc is a program to access build information from
the command line. The current script automatically generates
parrot-config.pbc. The auto-generation is useful because it allows
and easy, extendible way to add I<shortcuts> to build information.
For example, the build process produces two tags for build
information: B<cc_inc> and B<ld_share_flags> (this information is
obtained during the build process). So to obtain this information from
the command line one would write
$ parrot parrot-config.imc cc_inc ld_share_flags
But suppose one wanted (for whatever reason) to make a
shortcut to these two flags, one could define a shortcut called
B<--my-flag> that would print out the same data as would be printed
from the above command. Instead of above, we could write
$ parrot parrot-config.imc --my-flag
Defining shortcuts is straight forward. There is a hash named
%shortcut which contains all the shortcuts to be included in
parrot-config. An example is shown below
=begin text
my %shortcut = (
"--a", [[$TY_LIT,"SOME TEXT BABY"]],
"--b", shortcut_allkeys( qw{ cc_inc ld_share_flags } ),
"--c",
[[$TY_KEY,"cc_inc"],[$TY_LIT,"with-literal"],[$TY_KEY,"ld_share_flags"]],
"--dump", shortcut_code($dump_sub_code,"Dump all build values"),
"--shortcuts",shortcut_code($shortcut_sub_code,"Write all the shortcuts"),
"--usage",shortcut_code($usage_sub_code,"Write usage information")
);
=end text
We see that the value of shortcut is a list reference. The list may either
contain
=over 4
=item Literal and/or keys list
A list of pairs [TYPE,TEXT]. This is used to include I<literal>s verbatim or
I<keys> are looked up in the existing build data hash (PConfig). There is a
function
called C<shortcut_allkeys> which takes a list of literal keys and generates the
appropriate [$TY_KEY,TEXT] list.
=item Code segment
The result of a call to the subroutine shortcut_code(CODE-BODY,CODE-USAGE) where
CODE-BODY is the body of a parrot subroutine and CODE-USAGE is a one line
description
of the shortcut. The CODE-BODY is written like the normal body of a .pcc_sub
that
has been passed a hash called conf_hash -- which contains the contents of
PConfig and
%shortcut. See code for --dump or --shortcut below for example.
=back
One hopes that with literal,key and code types one can easily grok any
combination
of build data.
XXX The one addition would be to allow arguments to be passed at the command
line
to the subroutines. At some point though one has to worry about overkill :-).
Executing the script leaves only parrot-config.pbc in the root build directory.
See
the config variables below to leave various files in the build directory for
inspection.
parrot-config basically works by opening up a frozen pmc (generated by this
script)
and searching it for build data.
=head1 PROBLEMS
Lots of ugly HERE-DOCS are in this script.
=head1 SEE ALSO
Depends on F<lib/Parrot/Config.pm>.
Generates F<./parrot-config.pbc> and
F<runtime/parrot/include/parrot-config.fpmc>
=head1 AUTHORS
1/2005:
Pete Christopher wrote current script but stole loads of code from
config/gen/config_pm.pl (written by ??) and (the original code for)
parrot-config.imc (written by Leopold Toetsch)
=cut
#########################################
# CONFIGURATION VARIABLES:
# configures this script
#########################################
$this_script_name = 'build-parrot-config.pl';
$fpmc_location = 'runtime/parrot/include/parrot-config.fpmc';
$pconfig_location = 'lib/Parrot/Config.pm';
$output_basename = 'parrot-config-temp';
$leave_fpmc_script = 0; #leave the script that builds the fpmc in ROOT directory
$leave_config_imc_script = 0; #leave $output_basename.imc in ROOT directory
#########################################
# SUBROUTINE DEFS:
# defs for shortcut subroutines
#########################################
$dump_sub_code = <<EOF;
.local pmc iter
new iter, .Iterator, conf_hash
iter = .ITERATE_FROM_START
iter_loop:
unless iter goto iter_end
shift \$S0, iter
print \$S0
print " => '"
\$S1 = conf_hash[\$S0]
print \$S1
print "'\\n"
goto iter_loop
iter_end:
EOF
$shortcut_sub_code = <<EOF;
.local pmc iter
.local string dashdash,str_result
.local int string_type
.local pmc hash_result,undf
.local int hash_type
find_type string_type,"PerlString"
new iter, .Iterator, conf_hash
new undf,.Undef
iter = .ITERATE_FROM_START
dashdash = ""
iter_loop:
unless iter goto iter_end
shift \$S0, iter
length \$I0,\$S0
if \$I0 < 2 goto iter_loop
substr dashdash,\$S0,0,2
unless dashdash == "--" goto iter_loop
print \$S0
print " => "
hash_result = conf_hash[\$S0]
typeof hash_type,hash_result
if hash_type == string_type goto handle_string
str_result = hash_result(undf)
print "SUB: '"
print str_result
print "'"
goto bottom_hash_type_if
handle_string:
print "'"
print hash_result
print "'"
bottom_hash_type_if:
print "\\n"
goto iter_loop
iter_end:
EOF
$usage_sub_code = <<EOF;
print "parrot-config config-key [config-key, ....]\\n"
EOF
#######################################################
# PARROT_CONFIG BODY:
# contains most of the body of the parrot_config script
#######################################################
$parrot_config_script_body = <<EOF;
#+++++++++++++++++++++++++++++++++++++++
#THIS FILE MACHINE GENERATED FROM SCRIPT
# $this_script_name
# Don't modify this file
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
.include "iterator.pasm"
.sub _main [EMAIL PROTECTED]
.param pmc argv
.local int argc
.local pmc conf_hash
.local pmc hash_result
.local string key
.local int i,fail
.local int string_type,hash_type
#fetch the frozen pmc hash
conf_hash = _config()
argc = argv
if argc >= 2 goto argc_good
#call usage
hash_result = conf_hash["--usage"]
unless hash_result goto usage_botched
typeof hash_type,hash_result
find_type \$I0,"Sub"
unless hash_type == \$I0 goto usage_botched
hash_result(conf_hash)
exit 1
usage_botched:
printerr "INTERNAL ERROR: No --usage sub defined\\n"
printerr "Anyway you must have at least 2 args to this program\\n"
exit 1
argc_good:
#set string type
#XXX when a switch from PerlString String is made,
# must change this to "String"
find_type string_type,"PerlString"
# Check that the keys are defined
i = 1
fail = 0
loop1:
#do
key = argv[i]
\$I0 = defined conf_hash[key]
if \$I0 goto found1
print " no such key: '"
print key
print "'\\n"
set fail,1
found1:
inc i
if i < argc goto loop1
#endloop
if fail == 0 goto nofail
exit 1
nofail:
i = 1
loop2:
key = argv[i]
hash_result = conf_hash[key]
typeof hash_type,hash_result
if hash_type == string_type goto handle_string
hash_result(conf_hash)
goto bottom_loop2
handle_string:
print hash_result
bottom_loop2:
inc i
if i < argc goto loop2
print "\\n"
end
.end
.pcc_sub _config
.local pmc CONF
# XXX: this works only if parrot is run from its root directory
.const string conf_file = "$fpmc_location"
open CONF, conf_file, "<"
\$I0 = defined CONF
if \$I0 goto ok1
printerr "Can't read '"
printerr conf_file
printerr "': "
err \$S0
printerr \$S0
printerr "\\n"
exit 1
ok1:
.local string image
# If it gets above 64k, we've got bigger problems.
read image, CONF, 60000
close CONF
.local pmc conf_hash
thaw conf_hash, image
# XXX hash should probably be marked read-only...
#HERE WE GO AND FILL IN THE subs from the hash table
.local pmc glb
#START MACHINE GENERATED
<<ADD-SUBROUTINES-TO-HASH>>
#END MACHINE GENERATED
.pcc_begin_return
.return conf_hash
.pcc_end_return
miserable_fail:
printerr "Failed to find a subroutine: probably messed up\\n"
printerr "parrot-config-build.pl.\\n"
end
.end
#START MACHINE GENERATED
<<ADD-SUBROUTINE-BODIES>>
#END MACHINE GENERATED
EOF
##################################
# GENERATE FROZEN PMC SCRIPT BODY
##################################
$gen_frozen_pmc_script_body = <<EOF;
new P0, .PerlHash
new P1, .PerlUndef
<<HERE>>
# XXX: this works only if parrot is run from its root directory
open P1, "$fpmc_location", ">"
freeze S0, P0
print P1, S0
close P1
end
EOF
#########################################
# Define some (internal) global vars
#########################################
my ($TY_KEY,$TY_LIT,$TY_CODE) = (0,1,2);
my $code_data_shortcut = 0;
my %shortcut = (
"--a", [[$TY_LIT,"SOME TEXT BABY"]],
"--b", shortcut_allkeys( qw{ cc_inc ld_share_flags } ),
"--c",
[[$TY_KEY,"cc_inc"],[$TY_LIT,"with-literal"],[$TY_KEY,"ld_share_flags"]],
"--dump", shortcut_code($dump_sub_code,"Dump all build values"),
"--shortcuts",shortcut_code($shortcut_sub_code,"Write all the shortcuts"),
"--usage",shortcut_code($usage_sub_code,"Write usage information")
);
#########################################
# INTERNAL SUBS:
# Subs that do various things
#########################################
sub error_to_many_in_code {
my $flag = shift;
my $m = "Can only have one CODE object for flag $flag";
return $m;
}
#This just fetches the PConfig dump from Config.pm
#puts the result into global namespace.
#XXX probably more elegant way to do this, but
# I'm not very knowledgeable about perl.
sub fetch_PConfig {
my $fn = $pconfig_location;
my (@lines,$i,$j,$buffer);
open(IN,$fn) or die;
@lines = <IN>;
close(IN);
for($i=0; $i<$#lines; $i++){
$_ = $lines[$i];
last if /%PConfig = \(/;
}
$buffer = join('',@lines[$i .. $#lines]);
return eval $buffer;
}
sub proc_shortcut {
my $add_subs_to_hash = "";
my $next_sub_label = 0;
my $add_to_sub_def = "";
while( ($flag,$v) = each %shortcut ){
if($v->[0][0] == $TY_CODE){
#Handle code
die error_to_many_in_code($flag) unless @$v == 1;
my $sub_name = "_proc_shortcut_sub_" . $next_sub_label++;
my $code_body = $v->[0][1];
my $usage_line = $v->[0][2];
$add_subs_to_hash .= <<EOF;
find_global glb,"$sub_name"
unless glb,miserable_failiure
conf_hash["$flag"] = glb
EOF
$add_to_sub_def .= <<EOF;
.pcc_sub $sub_name
.param pmc conf_hash
.const string __usage_data = "$usage_line"
if conf_hash goto [EMAIL PROTECTED]
.return(__usage_data)
[EMAIL PROTECTED]:
$code_body
.return(S0) #don't use this value
.end
EOF
next;
}
#Ok must be a normal KEY,LIT list
my $buff = "";
for $e (@$v){
my $add;
my @elst = @$e;
if($elst[0] == $TY_KEY){
$add = $PConfig{$elst[1]};
die "Unkown key '$elst[1]' in shortcut" unless $add;
$buff .= " " . $add . " ";
}
elsif($elst[0] == $TY_LIT){
$add = $elst[1];
$buff .= " " . $add . " ";
}
elsif($elst[0] == $TY_CODE){
die error_to_many_in_code($flag) unless @$v == 1;
}
else {
die "Unhandled type in proc_shortcut";
}
}
$buff =~ s/[ ]+/ /g; #This could ass your $TY_LIT's, but I like single
spaces.
$PConfig{$flag} = $buff;
}
if($add_subs_to_hash){
$code_data_shortcut = [$add_subs_to_hash,$add_to_sub_def];
}
}
sub shortcut_code {
die "shortcut_code must have exaclty 2 args" unless @_ == 2;
my ($c,$u) = @_;
return [[$TY_CODE,$c,$u]];
}
sub shortcut_allkeys {
my $r = [];
for $s (@_){
push(@$r,[$TY_KEY,$s]);
}
return $r;
}
sub gen_frozen_pmc {
my ($k,$i,$buff);
my $random_name = $output_basename . "_fpmc_script.pasm";
my @gen_pmc_in = split(/\n/,$gen_frozen_pmc_script_body);
$buff = "";
for($i=0;$i<@gen_pmc_in; $i++){
$_ = $gen_pmc_in[$i];
if(/<<HERE>>/){
my @lst = sort { lc $a cmp lc $b || $a cmp $b } keys(%PConfig);
my $t = keys %PConfig;
for $k (@lst) {
my $v=$PConfig{$k};
if(defined $v) {
$v =~ s/(["\\])/\\$1/g; # "
$v =~ s/\n/\\n/g;
$buff .= qq(\tset P0["$k"], "$v"\n);
}
else {
$buff .= qq(\tset P0["$k"], P1\n);
}
}
}
else {
$buff .= $_ . "\n";
}
}
open(OUT,">" . $random_name) or die "Failed to open " . $random_name;
print OUT "$buff\n";
close(OUT);
system("parrot $random_name");
my $status = $?;
system("rm $random_name") unless $leave_fpmc_script;
die "Failed to compile parrot-config.fpmc" if $status != 0;
}
sub write_parrot_config {
open(OUT,">" . $output_basename . '.imc') or die;
if($code_data_shortcut){
my $add_subs_to_hash = $code_data_shortcut->[0];
my $add_to_sub_def = $code_data_shortcut->[1];
$parrot_config_script_body =~
s/<<ADD-SUBROUTINES-TO-HASH>>/$add_subs_to_hash/;
$parrot_config_script_body =~ s/<<ADD-SUBROUTINE-BODIES>>/$add_to_sub_def/;
}
else {
$parrot_config_script_body =~ s/<<ADD-SUBROUTINES-TO-HASH>>//;
$parrot_config_script_body =~ s/<<ADD-SUBROUTINE-BODIES>>//;
}
print OUT "$parrot_config_script_body\n";
close(OUT);
system("parrot -o $output_basename.pbc $output_basename.imc");
die "Failed to compile $output_basename.pbc" if $? != 0;
system("rm $output_basename.imc") unless $leave_config_imc_script;
}
sub main {
#go and fetch configuration data
fetch_PConfig();
proc_shortcut();
gen_frozen_pmc();
write_parrot_config();
}
#call main
main();
