package SPVM::Global;
use strict;
use warnings;
use Carp 'confess';
use SPVM::BlessedObject;
use SPVM::BlessedObject::Array;
use SPVM::BlessedObject::Class;
use SPVM::BlessedObject::String;
use SPVM ();
use SPVM::Builder;
use SPVM::Builder::Runtime;
use SPVM::ExchangeAPI;
our $BUILDER;
our $BUILDER_ENV;
our $BUILDER_STACK;
our $BUILDER_API;
our $COMPILER;
our $RUNTIME;
our $DYNAMIC_LIB_FILES = {};
our $ENV;
our $STACK;
our $API;
sub load_dynamic_libs {
my ($runtime, $dynamic_lib_files) = @_;
my $class_names = $runtime->get_class_names->to_strings;
# Set addresses of native methods and precompile methods
for my $class_name (@$class_names) {
next if $class_name =~ /::anon/;
for my $category ('precompile', 'native') {
my $cc = SPVM::Builder::CC->new(
build_dir => $BUILDER->build_dir,
at_runtime => 1,
);
my $get_method_names_options = $runtime->__api->new_options({
$category => $runtime->__api->class('Int')->new(1)
});
my $method_names = $runtime->get_method_names($class_name, $get_method_names_options)->to_strings;
if (@$method_names) {
# Build classs - Compile C source codes and link them to SPVM precompile method
# Shared library which is already installed in distribution directory
my $module_file = $runtime->get_module_file($class_name)->to_string;
my $dynamic_lib_file = SPVM::Builder::Util::get_dynamic_lib_file_dist($module_file, $category);
# Try to build the shared library at runtime if shared library is not found
unless (-f $dynamic_lib_file) {
my $module_file = $runtime->get_module_file($class_name)->to_string;
my $method_names = $runtime->get_method_names($class_name, $get_method_names_options)->to_strings;
my $anon_class_names = $runtime->get_anon_class_names($class_name)->to_strings;
my $dl_func_list = SPVM::Builder::Util::create_dl_func_list($class_name, $method_names, $anon_class_names, {category => $category});
my $precompile_source = $runtime->build_precompile_class_source($class_name)->to_string;
$dynamic_lib_file = $cc->build_at_runtime($class_name, {module_file => $module_file, category => $category, dl_func_list => $dl_func_list, precompile_source => $precompile_source});
}
if (-f $dynamic_lib_file) {
$dynamic_lib_files->{$category}{$class_name} = $dynamic_lib_file;
}
}
}
}
# Set function addresses of native and precompile methods
for my $category ('precompile', 'native') {
my $get_method_names_options = $runtime->__api->new_options({
$category => $runtime->__api->class('Int')->new(1)
});
for my $class_name (keys %{$dynamic_lib_files->{$category}}) {
next unless grep { "$_" eq $class_name } @$class_names;
my $dynamic_lib_file = $dynamic_lib_files->{$category}{$class_name};
my $method_names = $runtime->get_method_names($class_name, $get_method_names_options)->to_strings;
my $anon_class_names = $runtime->get_anon_class_names($class_name)->to_strings;
my $method_addresses = SPVM::Builder::Util::get_method_addresses($dynamic_lib_file, $class_name, $method_names, $anon_class_names, $category);
for my $method_name (sort keys %$method_addresses) {
my $cfunc_address = $method_addresses->{$method_name};
if ($category eq 'native') {
$runtime->set_native_method_address($class_name, $method_name, $runtime->__api->new_address_object($cfunc_address));
}
elsif ($category eq 'precompile') {
$runtime->set_precompile_method_address($class_name, $method_name, $runtime->__api->new_address_object($cfunc_address));
}
}
}
}
}
sub init_runtime {
unless ($RUNTIME) {
unless ($BUILDER) {
my $build_dir = $ENV{SPVM_BUILD_DIR};
$BUILDER = SPVM::Builder->new(build_dir => $build_dir);
}
my $builder_compiler = SPVM::Builder::Compiler->new(
module_dirs => $BUILDER->module_dirs
);
# Load SPVM Compilers
$builder_compiler->use("Compiler", __FILE__, __LINE__);
$builder_compiler->use("Runtime", __FILE__, __LINE__);
$builder_compiler->use("Env", __FILE__, __LINE__);
$builder_compiler->use("Stack", __FILE__, __LINE__);
my $builder_runtime = $builder_compiler->build_runtime;
$builder_runtime->load_dynamic_libs;
# Build an environment
$BUILDER_ENV = $builder_runtime->build_env;
# Set command line info
$BUILDER_ENV->set_command_info_program_name($0);
$BUILDER_ENV->set_command_info_argv(\@ARGV);
my $base_time = $^T + 0; # For Perl 5.8.9
$BUILDER_ENV->set_command_info_base_time($base_time);
# Call INIT blocks
$BUILDER_ENV->call_init_blocks;
$BUILDER_STACK = $BUILDER_ENV->build_stack;
$BUILDER_API = SPVM::ExchangeAPI->new(env => $BUILDER_ENV, stack => $BUILDER_STACK);
$COMPILER = $BUILDER_API->class("Compiler")->new;
for my $module_dir (@{$BUILDER->module_dirs}) {
$COMPILER->add_module_dir($module_dir);
}
$RUNTIME = $COMPILER->build_runtime;
&load_dynamic_libs($RUNTIME, $DYNAMIC_LIB_FILES);
}
}
my $BIND_TO_PERL_CLASS_NAME_H = {};
sub bind_to_perl {
my ($class_name) = @_;
my $perl_class_name_base = "SPVM::";
my $perl_class_name = "$perl_class_name_base$class_name";
unless ($BIND_TO_PERL_CLASS_NAME_H->{$perl_class_name}) {
my $parent_class_name = $RUNTIME->get_parent_class_name($class_name);
my $parent_class_name_str = defined $parent_class_name ? "($parent_class_name)" : "()";
# The inheritance
my @isa;
if (defined $parent_class_name) {
push @isa, "$perl_class_name_base$parent_class_name";
}
push @isa, 'SPVM::BlessedObject::Class';
my $isa = "our \@ISA = (" . join(',', map { "'$_'" } @isa) . ");";
my $code = "package $perl_class_name; $isa";
eval $code;
if (my $error = $@) {
confess $error;
}
$BIND_TO_PERL_CLASS_NAME_H->{$perl_class_name_base}{$perl_class_name} = 1;
}
my $method_names = $RUNTIME->get_method_names($class_name);
for my $method_name (@$method_names) {
# Destrutor is skip
if ($method_name eq 'DESTROY') {
next;
}
# Anon method is skip
elsif (length $method_name == 0) {
next;
}
my $perl_method_abs_name = "${perl_class_name}::$method_name";
my $is_class_method = $RUNTIME->get_method_is_class_method($class_name, $method_name);
if ($is_class_method) {
# Define Perl method
no strict 'refs';
# Suppress refer to objects
my $class_name_string = "$class_name";
my $method_name_string = "$method_name";
*{"$perl_method_abs_name"} = sub {
my $perl_class_name = shift;
my $return_value;
eval { $return_value = SPVM::api()->call_method($class_name_string, $method_name_string, @_) };
my $error = $@;
if ($error) {
confess $error;
}
$return_value;
};
}
}
}
sub build_class {
my ($class_name, $file, $line) = @_;
unless ($BUILDER) {
my $build_dir = $ENV{SPVM_BUILD_DIR};
$BUILDER = SPVM::Builder->new(build_dir => $build_dir);
}
my $start_classes_length = 0;
if ($RUNTIME) {
$start_classes_length = $RUNTIME->get_classes_length;
}
&init_runtime();
# Add class informations
my $build_success;
if (defined $class_name) {
$COMPILER->set_start_file($file);
$COMPILER->set_start_line($line);
my $success = $COMPILER->compile($class_name);
unless ($success) {
my $error_messages = $COMPILER->get_error_messages;
for my $error_message (@$error_messages) {
printf STDERR "[CompileError]$error_message\n";
}
$COMPILER = undef;
exit(255);
}
$RUNTIME = $COMPILER->build_runtime;
&load_dynamic_libs($RUNTIME, $DYNAMIC_LIB_FILES);
}
}
sub init_api {
&init_runtime();
$ENV = $RUNTIME->build_env;
$ENV->set_command_info_program_name($0);
$ENV->set_command_info_argv(\@ARGV);
my $base_time = $^T + 0; # For Perl 5.8.9
$ENV->set_command_info_base_time($base_time);
$ENV->call_init_blocks;
$STACK = $ENV->build_stack;
$API = SPVM::ExchangeAPI->new(env => $ENV, stack => $STACK);
}
END {
$BUILDER = undef;
$COMPILER = undef;
$API = undef;
$STACK = undef;
$ENV = undef;
$RUNTIME = undef;
$DYNAMIC_LIB_FILES = undef;
$BUILDER_API = undef;
$BUILDER_STACK = undef;
$BUILDER_ENV = undef;
}
=head1 Name
SPVM::Global - SPVM Global Instance for Perl Interpreter
=head1 Copyright & License
Copyright (c) 2023 Yuki Kimoto
MIT License