File Coverage

blib/lib/SPVM/Builder/Exe.pm
Criterion Covered Total %
statement 404 501 80.6
branch 32 72 44.4
condition 2 8 25.0
subroutine 45 50 90.0
pod 0 28 0.0
total 483 659 73.2


line stmt bran cond sub pod time code
1             package SPVM::Builder::Exe;
2              
3 1     1   85075 use strict;
  1         14  
  1         36  
4 1     1   6 use warnings;
  1         2  
  1         28  
5 1     1   5 use Carp 'confess';
  1         2  
  1         47  
6 1     1   621 use Pod::Usage 'pod2usage';
  1         52530  
  1         99  
7 1     1   10 use Config;
  1         2  
  1         39  
8              
9 1     1   477 use SPVM::Builder;
  1         4  
  1         37  
10 1     1   8 use SPVM::Builder::CC;
  1         2  
  1         25  
11 1     1   5 use SPVM::Builder::Util;
  1         2  
  1         33  
12 1     1   1148 use SPVM::Builder::Config::Exe;
  1         3  
  1         29  
13 1     1   844 use JSON::PP;
  1         14665  
  1         76  
14              
15 1     1   8 use SPVM 'Native::Compiler';
  1         2  
  1         6  
16 1     1   10 use SPVM 'Native::Runtime';
  1         3  
  1         5  
17              
18 1     1   9 use File::Spec;
  1         3  
  1         34  
19 1     1   6 use File::Find 'find';
  1         2  
  1         72  
20              
21 1     1   6 use Getopt::Long 'GetOptions';
  1         2  
  1         10  
22              
23 1     1   153 use File::Copy 'copy', 'move';
  1         3  
  1         51  
24 1     1   6 use File::Path 'mkpath';
  1         3  
  1         44  
25 1     1   6 use DynaLoader;
  1         3  
  1         29  
26 1     1   5 use Scalar::Util 'weaken';
  1         4  
  1         45  
27              
28 1     1   6 use File::Basename 'dirname', 'basename';
  1         2  
  1         2953  
29              
30             # Fields
31             sub builder {
32 361     361 0 864 my $self = shift;
33 361 50       854 if (@_) {
34 0         0 $self->{builder} = $_[0];
35 0         0 return $self;
36             }
37             else {
38 361         1877 return $self->{builder};
39             }
40             }
41              
42             sub include_dirs {
43 0     0 0 0 my $self = shift;
44 0 0       0 if (@_) {
45 0         0 $self->builder->include_dirs($_[0]);
46 0         0 return $self;
47             }
48             else {
49 0         0 return $self->builder->include_dirs;
50             }
51             }
52              
53             sub class_name {
54 8     8 0 27 my $self = shift;
55 8 50       34 if (@_) {
56 0         0 $self->{class_name} = $_[0];
57 0         0 return $self;
58             }
59             else {
60 8         35 return $self->{class_name};
61             }
62             }
63              
64             sub output_file {
65 0     0 0 0 my $self = shift;
66 0 0       0 if (@_) {
67 0         0 $self->{output_file} = $_[0];
68 0         0 return $self;
69             }
70             else {
71 0         0 return $self->{output_file};
72             }
73             }
74              
75             sub quiet {
76 166     166 0 381 my $self = shift;
77 166 50       423 if (@_) {
78 0         0 $self->{quiet} = $_[0];
79 0         0 return $self;
80             }
81             else {
82 166         583 return $self->{quiet};
83             }
84             }
85              
86             sub force {
87 276     276 0 528 my $self = shift;
88 276 50       710 if (@_) {
89 0         0 $self->{force} = $_[0];
90 0         0 return $self;
91             }
92             else {
93 276         2772 return $self->{force};
94             }
95             }
96              
97             sub config {
98 179     179 0 479 my $self = shift;
99 179 50       485 if (@_) {
100 0         0 $self->{config} = $_[0];
101 0         0 return $self;
102             }
103             else {
104 179         580 return $self->{config};
105             }
106             }
107              
108             sub config_file {
109 0     0 0 0 my $self = shift;
110 0 0       0 if (@_) {
111 0         0 $self->{config_file} = $_[0];
112 0         0 return $self;
113             }
114             else {
115 0         0 return $self->{config_file};
116             }
117             }
118              
119             sub compiler {
120 4     4 0 8 my $self = shift;
121 4 50       15 if (@_) {
122 0         0 $self->{compiler} = $_[0];
123 0         0 return $self;
124             }
125             else {
126 4         11 return $self->{compiler};
127             }
128             }
129              
130             sub runtime {
131 244     244 0 401 my $self = shift;
132 244 100       501 if (@_) {
133 2         8 $self->{runtime} = $_[0];
134 2         6 return $self;
135             }
136             else {
137 242         1739 return $self->{runtime};
138             }
139             }
140              
141             # Methods
142             sub new {
143 2     2 0 2316 my $class = shift;
144            
145 2         17 my $self = {@_};
146            
147             # Target class name
148 2         21 my $basic_type_name = $self->{class_name};
149 2 50       16 unless (defined $basic_type_name) {
150 0         0 confess "A class name not specified";
151             }
152            
153             # Excutable file name
154 2         7 my $output_file = $self->{output_file};
155 2 50       8 unless (defined $output_file) {
156 0         0 $output_file = $basic_type_name;
157 0         0 $output_file =~ s/::/__/g;
158 0         0 $self->{output_file} = $output_file;
159             }
160            
161             # Build directory
162 2         10 my $build_dir = delete $self->{build_dir};
163            
164 2 50       11 unless (defined $build_dir) {
165 0         0 $build_dir = '.spvm_build';
166             }
167              
168             # Class paths
169 2         6 my $include_dirs = delete $self->{include_dirs};
170 2 50       7 unless (defined $include_dirs) {
171 0         0 $include_dirs = [];
172             }
173            
174             # New SPVM::Builder object
175 2         33 my $builder = SPVM::Builder->new(
176             build_dir => $build_dir,
177             include_dirs => $include_dirs
178             );
179            
180             # Config file
181 2         6 my $config_file = $self->{config_file};
182            
183             # Config
184 2         5 my $config;
185 2 100       17 if (defined $config_file) {
186 1         16 $config = SPVM::Builder::Config::Exe->load_config($config_file);
187 1 50       4 unless ($config->output_type eq 'exe') {
188 0         0 confess "Config file \"$config_file\" is not the config to create the executable file";
189             }
190             }
191             else {
192 1         35 $config = SPVM::Builder::Config::Exe->new_gnu99(file_optional => 1);
193             }
194 2         11 $config->class_name($basic_type_name);
195            
196 2         4 $self->{config} = $config;
197            
198 2         9 $self->{builder} = $builder;
199            
200 2         32 my $compiler = SPVM::Native::Compiler->new;
201 2         6 $compiler->add_include_dir($_) for @{$builder->include_dirs};
  2         14  
202 2         8 $self->{compiler} = $compiler;
203            
204 2         9 return bless $self, $class;
205             }
206              
207             sub build_exe_file {
208 2     2 0 15 my ($self) = @_;
209            
210             # Builder
211 2         15 my $builder = $self->builder;
212            
213 2         7 my $basic_type_name = $self->{class_name};
214            
215             # Build runtime
216 2 50       7 unless ($self->{finish_compile}) {
217 2         18 $self->compile;
218             }
219            
220 2         7 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
221            
222 2         17 my $class_file = $basic_type->_get_class_file;
223            
224             # Object files
225 2         8 my $object_files = [];
226            
227             # Compile SPVM core source files
228 2         19 my $spvm_core_object_files = $self->compile_spvm_core_source_files;
229 2         64 push @$object_files, @$spvm_core_object_files;
230            
231 2         41 my $modules_object_files = $self->compile_modules;
232 2         25 push @$object_files, @$modules_object_files;
233            
234             # Create bootstrap C source
235 2         44 $self->create_bootstrap_source;
236            
237             # Compile bootstrap C source
238 2         78 my $bootstrap_object_file = $self->compile_bootstrap_source_file;
239 2         42 push @$object_files, $bootstrap_object_file;
240            
241             # Build directory
242 2         70 my $build_dir = $self->builder->build_dir;
243 2         229 mkpath $build_dir;
244            
245             # Link and generate executable file
246 2         34 my $config_exe = $self->config;
247 2         28 my $cc_linker = SPVM::Builder::CC->new(
248             build_dir => $build_dir,
249             quiet => $self->quiet,
250             force => $self->force,
251             );
252             my $options = {
253             output_file => $self->{output_file},
254 2         36 config => $self->config,
255             category => 'native',
256             };
257            
258 2         41 $cc_linker->link($basic_type_name, $object_files, $options);
259             }
260              
261             sub get_required_resources {
262 0     0 0 0 my ($self) = @_;
263            
264 0         0 my $config_exe = $self->config;
265            
266 0 0       0 unless ($self->{finish_compile}) {
267 0         0 $self->compile;
268             }
269            
270 0         0 my $required_resources = [];
271            
272 0         0 my $builder = $self->builder;
273              
274 0         0 my $build_dir = $self->builder->build_dir;
275            
276             # Compiler for native class
277 0         0 my $builder_cc = SPVM::Builder::CC->new(
278             build_dir => $build_dir,
279             quiet => $self->quiet,
280             force => $self->force,
281             );
282            
283 0         0 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
284 0         0 my $all_object_files = [];
285 0         0 for my $basic_type_name (@$basic_type_names) {
286            
287 0         0 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
288            
289 0         0 my $perl_basic_type_name = "SPVM::$basic_type_name";
290            
291 0         0 my $native_method_names = $basic_type->_get_native_method_names;
292 0 0       0 if (@$native_method_names) {
293 0         0 my $class_file = $basic_type->_get_class_file;
294 0         0 my $native_dir = $class_file;
295            
296 0         0 $native_dir =~ s/\.spvm$//;
297 0         0 $native_dir .= 'native';
298 0         0 my $input_dir = SPVM::Builder::Util::remove_basic_type_name_part_from_file($class_file, $perl_basic_type_name);
299 0         0 my $build_object_dir = SPVM::Builder::Util::create_build_object_path($self->builder->build_dir);
300 0         0 mkpath $build_object_dir;
301            
302 0 0       0 unless (defined $class_file) {
303 0         0 my $config_exe_file = SPVM::Builder::Util::get_config_file_from_basic_type_name($basic_type_name);
304 0 0       0 if ($config_exe_file) {
305 0         0 $class_file = $config_exe_file;
306 0         0 $class_file =~ s/\.config$/\.spvm/;
307             }
308             else {
309 0         0 confess "The class file \"$class_file\" is not found";
310             }
311             }
312 0         0 my $config_exe = $builder->create_native_config_from_class_file($class_file);
313            
314 0         0 my $resource_names = $config_exe->get_resource_names;
315 0         0 for my $resource_name (@$resource_names) {
316 0         0 my $resource = $config_exe->get_resource($resource_name);
317            
318 0         0 my $resource_info = {
319             class_name => $basic_type_name,
320             resource => $resource
321             };
322            
323 0         0 push @$required_resources, $resource_info;
324             }
325             }
326             }
327            
328 0         0 return $required_resources;
329             }
330              
331             sub get_required_resource_json_lines {
332 0     0 0 0 my ($self) = @_;
333            
334 0         0 my $required_resources = $self->get_required_resources;
335            
336 0         0 my @json_lines;
337 0         0 for my $required_resource (@$required_resources) {
338 0         0 my $basic_type_name = $required_resource->{class_name};
339 0         0 my $resource = $required_resource->{resource};
340 0         0 my $resource_basic_type_name = $resource->class_name;
341 0         0 my $resource_mode = $resource->mode;
342 0   0     0 my $resource_argv = $resource->argv || [];
343            
344 0         0 my $line = {
345             caller_class_name => "$basic_type_name",
346             resource => {
347             class_name => $resource_basic_type_name,
348             }
349             };
350 0 0       0 if (defined $resource_mode) {
351 0         0 $line->{resource}{mode} = $resource_mode;
352             }
353            
354 0 0       0 if (@$resource_argv) {
355 0         0 $line->{resource}{argv} = $resource_argv;
356             }
357            
358 0         0 my $json_line = JSON::PP->new->utf8->canonical(1)->encode($line);
359            
360 0         0 push @json_lines, $json_line;
361             }
362            
363 0         0 return \@json_lines;
364             }
365              
366             sub compile {
367 2     2 0 6 my ($self) = @_;
368              
369             # Builder
370 2         6 my $builder = $self->builder;
371            
372 2         5 my $basic_type_name = $self->{class_name};
373            
374 2         11 my $compiler = $self->compiler;
375            
376 2         16 $compiler->set_start_file(__FILE__);
377 2         18 $compiler->set_start_line(__LINE__ + 1);
378 2         15 my $success = $compiler->compile($basic_type_name);
379 2 50       14 unless ($success) {
380 0         0 my $error_messages = $compiler->get_error_messages;
381 0         0 for my $error_message (@$error_messages) {
382 0         0 print STDERR "$error_message\n";
383             }
384 0         0 exit(255);
385             }
386 2         22 my $runtime = $compiler->get_runtime;
387            
388 2         14 $self->runtime($runtime);
389            
390 2         9 $self->{finish_compile} = 1;
391             }
392              
393             sub compile_modules {
394 2     2 0 12 my ($self) = @_;
395              
396 2         27 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
397            
398 2         15 my $object_files = [];
399 2         86 for my $basic_type_name (@$basic_type_names) {
400 28         112 my $precompile_object_files = $self->compile_module_precompile_source_file($basic_type_name);
401 28         87 push @$object_files, @$precompile_object_files;
402            
403 28         112 my $native_object_files = $self->compile_module_native_source_files($basic_type_name);
404 28         119 push @$object_files, @$native_object_files;
405             }
406            
407 2         456 return $object_files;
408             }
409              
410             sub create_source_file {
411 2     2 0 12 my ($self, $options) = @_;
412            
413             # Config
414 2         17 my $config_exe = $self->config;
415            
416 2         6 my $input_files = $options->{input_files};
417 2         13 my $output_file = $options->{output_file};
418 2         11 my $create_cb = $options->{create_cb};
419            
420 2         43 my $config_exe_loaded_config_files = $config_exe->get_loaded_config_files;
421 2         19 my $need_generate_input_files = [@$input_files, @$config_exe_loaded_config_files];
422 2   33     18 my $need_generate = SPVM::Builder::Util::need_generate({
423             force => $self->force || $config_exe->force,
424             output_file => $output_file,
425             input_files => $need_generate_input_files,
426             });
427            
428 2 50       26 if ($need_generate) {
429 2         8 $create_cb->();
430             }
431             }
432              
433             sub compile_source_file {
434 108     108 0 412 my ($self, $options) = @_;
435            
436 108         300 my $source_file = $options->{source_file};
437 108         237 my $output_file = $options->{output_file};
438 108         248 my $config = $options->{config};
439 108         866 my $config_exe = $self->config;
440            
441 108         1260 my $config_exe_loaded_config_files = $config_exe->get_loaded_config_files;
442 108         418 my $config_loaded_config_files = $config->get_loaded_config_files;
443 108         435 my $need_generate_input_files = [$source_file, @$config_loaded_config_files, @$config_exe_loaded_config_files];
444 108   33     635 my $need_generate = SPVM::Builder::Util::need_generate({
445             force => $self->force || $config->force,
446             output_file => $output_file,
447             input_files => $need_generate_input_files,
448             });
449            
450 108         1090 my $builder = $self->builder;
451            
452             # Build directory
453 108         313 my $build_dir = $self->builder->build_dir;
454            
455             # Compile command
456 108         498 my $builder_cc = SPVM::Builder::CC->new(
457             build_dir => $build_dir,
458             quiet => $self->quiet,
459             force => $self->force,
460             );
461            
462 108         1136 my $before_each_compile_cbs = $config_exe->before_each_compile_cbs;
463 108         1057 $config->add_before_compile_cb(@$before_each_compile_cbs);
464            
465 108         835 my $compile_info = SPVM::Builder::CompileInfo->new(
466             output_file => $output_file,
467             source_file => $source_file,
468             config => $config,
469             );
470            
471 108 100       304 if ($need_generate) {
472 55         298 $builder_cc->compile_source_file($compile_info);
473             }
474            
475 108         19275268 my $object_file_name = $compile_info->output_file;
476 108         1315 my $object_file = SPVM::Builder::ObjectFileInfo->new(
477             file => $object_file_name,
478             compile_info => $compile_info,
479             );
480            
481 108         3457 return $object_file;
482             }
483              
484             sub create_bootstrap_header_source {
485 2     2 0 12 my ($self) = @_;
486              
487             # Config
488 2         13 my $config_exe = $self->config;
489              
490             # Builder
491 2         9 my $builder = $self->builder;
492              
493 2         18 my $basic_type_name = $self->class_name;
494              
495 2         7 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
496            
497 2         8 my $source = '';
498            
499 2         12 $source .= <<'EOS';
500              
501             #include
502             #include
503             #include
504             #include
505             #include
506             #include
507              
508             // Only used for setmode function and _O_BINARY
509             #include
510              
511             #include "spvm_native.h"
512              
513             EOS
514            
515 2         14 $source .= "// precompile functions declaration\n";
516 2         11 for my $basic_type_name (@$basic_type_names) {
517 28         96 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
518 28         147 my $precompile_method_names = $basic_type->_get_precompile_method_names;
519 28         89 for my $method_name (@$precompile_method_names) {
520 5         13 my $method_cname = $basic_type_name;
521 5         22 $method_cname =~ s/::/__/g;
522 5         21 $source .= <<"EOS";
523             int32_t SPVMPRECOMPILE__${method_cname}__$method_name(SPVM_ENV* env, SPVM_VALUE* stack);
524             EOS
525             }
526             }
527              
528 2         195 $source .= "static void SPVM_BOOTSTRAP_create_bootstrap_set_precompile_method_addresses(SPVM_ENV* env);\n";
529              
530 2         23 $source .= <<"EOS";
531             static void SPVM_BOOTSTRAP_set_precompile_method_address(SPVM_ENV* env, const char* class_name, const char* method_name, void* precompile_address) {
532             void* module_basic_type = env->api->runtime->get_basic_type_by_name(env->runtime, class_name);
533             void* method = env->api->basic_type->get_method_by_name(env->runtime, module_basic_type, method_name);
534             env->api->method->set_precompile_address(env->runtime, method, precompile_address);
535             }
536             EOS
537            
538 2         18 $source .= "// native functions declaration\n";
539 2         14 for my $basic_type_name (@$basic_type_names) {
540 28         88 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
541 28         131 my $native_method_names = $basic_type->_get_native_method_names;
542 28         91 for my $method_name (@$native_method_names) {
543 4         7 my $basic_type_name = $basic_type_name;
544 4         10 $basic_type_name =~ s/::/__/g;
545 4         13 $source .= <<"EOS";
546             int32_t SPVM__${basic_type_name}__$method_name(SPVM_ENV* env, SPVM_VALUE* stack);
547             EOS
548             }
549             }
550              
551 2         191 $source .= "static void SPVM_BOOTSTRAP_create_bootstrap_set_native_method_addresses(SPVM_ENV* env);\n\n";
552              
553 2         7 $source .= "static void* SPVM_BOOTSTRAP_get_runtime(SPVM_ENV* env, void* compiler);\n\n";
554              
555 2         9 $source .= <<"EOS";
556             static void SPVM_BOOTSTRAP_set_native_method_address(SPVM_ENV* env, const char* class_name, const char* method_name, void* native_address) {
557             void* module_basic_type = env->api->runtime->get_basic_type_by_name(env->runtime, class_name);
558             void* method = env->api->basic_type->get_method_by_name(env->runtime, module_basic_type, method_name);
559             env->api->method->set_native_address(env->runtime, method, native_address);
560             }
561             EOS
562              
563 2         38 return $source;
564             }
565              
566             sub create_bootstrap_main_func_source {
567 2     2 0 14 my ($self) = @_;
568              
569             # Builder
570 2         14 my $builder = $self->builder;
571              
572 2         10 my $basic_type_name = $self->class_name;
573              
574 2         10 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
575              
576 2         7 my $source = '';
577              
578 2         38 $source .= <<"EOS";
579              
580             int32_t main(int32_t command_args_length, const char *command_args[]) {
581              
582             // Binary mode in all systems
583             #ifdef _WIN32
584             setmode(fileno(stdout), _O_BINARY);
585             setmode(fileno(stderr), _O_BINARY);
586             setmode(fileno(stdin), _O_BINARY);
587             #endif
588            
589             // Create env
590             SPVM_ENV* env_api = SPVM_API_new_env();
591            
592             // Compiler
593             void* compiler = env_api->api->compiler->new_instance();
594            
595             void* runtime = SPVM_BOOTSTRAP_get_runtime(env_api, compiler);
596            
597             SPVM_ENV* env = env_api->new_env();
598            
599             env->runtime = runtime;
600            
601             // Set precompile method addresses
602             SPVM_BOOTSTRAP_create_bootstrap_set_precompile_method_addresses(env);
603            
604             // Set native method addresses
605             SPVM_BOOTSTRAP_create_bootstrap_set_native_method_addresses(env);
606            
607             SPVM_VALUE* stack = env->new_stack(env);
608            
609             int32_t error = 0;
610            
611             // Set the program name and the command line arguments
612             {
613             // Enter scope
614             int32_t scope_id = env->enter_scope(env, stack);
615            
616             // Program name - string
617             void* obj_program_name = env->new_string(env, stack, command_args[0], strlen(command_args[0]));
618            
619             // ARGV - string[]
620             void* obj_argv = env->new_string_array(env, stack, command_args_length - 1);
621             for (int32_t arg_index = 1; arg_index < command_args_length; arg_index++) {
622             void* obj_arg = env->new_string(env, stack, command_args[arg_index], strlen(command_args[arg_index]));
623             env->set_elem_object(env, stack, obj_argv, arg_index - 1, obj_arg);
624             }
625            
626             // Base time
627             int64_t base_time = time(NULL);
628            
629             // Set command info
630             {
631             int32_t e;
632             e = env->set_command_info_program_name(env, stack, obj_program_name);
633             assert(e == 0);
634             e = env->set_command_info_argv(env, stack, obj_argv);
635             assert(e == 0);
636             e = env->set_command_info_base_time(env, stack, base_time);
637             assert(e == 0);
638             }
639             // Leave scope
640             env->leave_scope(env, stack, scope_id);
641            
642             }
643            
644             // Call INIT blocks
645            
646             int32_t status = 0;
647             error = env->call_init_methods(env, stack);
648             if (error) {
649             env->print_stderr(env, stack, env->get_exception(env, stack));
650             printf("\\n");
651             status = 255;
652             }
653             else {
654            
655             // Class name
656             const char* class_name = "$basic_type_name";
657            
658             // Class
659             void* module_basic_type = env->api->runtime->get_basic_type_by_name(env->runtime, class_name);
660             void* method = env->api->basic_type->get_method_by_name(env->runtime, module_basic_type, "main");
661            
662             if (!method) {
663             fprintf(stderr, "The class method %s->main is not defined\\n", class_name);
664             return -1;
665             }
666            
667             // Run
668             int32_t args_width = 0;
669             error = env->call_method(env, stack, method, args_width);
670            
671             if (error) {
672             env->print_stderr(env, stack, env->get_exception(env, stack));
673             printf("\\n");
674             status = 255;
675             }
676             else {
677             status = stack[0].ival;
678             }
679             }
680            
681             env->destroy_class_vars(env, stack);
682            
683             env->free_stack(env, stack);
684            
685             env->free_env(env);
686            
687             env_api->api->compiler->free_instance(compiler);
688            
689             env_api->free_env(env_api);
690            
691             return status;
692             }
693             EOS
694              
695 2         67 return $source;
696             }
697              
698             sub create_bootstrap_get_runtime_source {
699 2     2 0 9 my ($self) = @_;
700            
701             # Builder
702 2         7 my $builder = $self->builder;
703            
704 2         17 my $source = '';
705            
706 2         13 $source .= <<"EOS";
707             static void* SPVM_BOOTSTRAP_get_runtime(SPVM_ENV* env, void* compiler) {
708            
709             EOS
710            
711 2         12 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
712            
713 2         13 my $compiler = $self->compiler;
714            
715 2         10 for my $basic_type_name (@$basic_type_names) {
716 28         104 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
717            
718 28         156 my $class_file = $compiler->get_class_file($basic_type_name);
719            
720 28         139 my $class_file_rel_file = $class_file->get_rel_file;
721            
722 28         140 my $class_file_content = $class_file->get_content;
723            
724 28         132 my $class_file_content_length = $class_file->get_content_length;
725            
726 28         52 my $source_class_file = '';
727            
728 28         55 $source_class_file .= qq| {\n|;
729            
730 28         103 $source_class_file .= qq| env->api->compiler->add_class_file(compiler, "$basic_type_name");\n|;
731            
732 28         80 $source_class_file .= qq| void* class_file = env->api->compiler->get_class_file(compiler, "$basic_type_name");\n|;
733            
734 28 50       70 if (defined $class_file_rel_file) {
735 28         70 $source_class_file .= qq| env->api->class_file->set_rel_file(compiler, class_file, "$class_file_rel_file");\n|;
736             }
737            
738 28 50       70 if (defined $class_file_content) {
739 28         46 my $content_espcaped = $class_file_content;
740            
741             {
742 1     1   12 use bytes;
  1         4  
  1         8  
  28         45  
743 28         69 $content_espcaped =~ s/\\/\\\\/g;
744 28         94 $content_espcaped =~ s/"/\\"/g;
745 28         78 $content_espcaped =~ s/([^[:print:]])/sprintf("\\%03o", ord($1))/ge;
  228         848  
746             }
747            
748 28         105 $source_class_file .= qq| env->api->class_file->set_content(compiler, class_file, "$content_espcaped");\n|;
749             }
750            
751 28         83 $source_class_file .= qq| env->api->class_file->set_content_length(compiler, class_file, $class_file_content_length);\n|;
752            
753 28         43 $source_class_file .= qq| }\n|;
754            
755 28         1115 $source .= $source_class_file;
756             }
757            
758 2         187 $source .= qq| env->api->compiler->set_start_file(compiler, __FILE__);\n|;
759            
760 2         13 $source .= qq| env->api->compiler->set_start_line(compiler, __LINE__ + 1);\n|;
761            
762 2         8 my $start_basic_type_name = $self->{class_name};
763            
764 2         10 $source .= qq| int32_t error_id = env->api->compiler->compile(compiler, \"$start_basic_type_name\");\n|;
765            
766 2         5 $source .= qq| if (error_id != 0) {\n|;
767 2         6 $source .= qq| fprintf(stderr, "[Unexpected Compile Error]%s.", env->api->compiler->get_error_message(compiler, 0));\n|;
768 2         4 $source .= qq| exit(255);\n|;
769 2         5 $source .= qq| }\n|;
770            
771 2         4 $source .= qq| void* runtime = env->api->compiler->get_runtime(compiler);\n|;
772            
773 2         6 $source .= qq| return runtime;\n|;
774            
775 2         4 $source .= <<"EOS";
776             }
777             EOS
778            
779 2         124 return $source;
780             }
781              
782             sub create_bootstrap_set_precompile_method_addresses_func_source {
783 2     2 0 10 my ($self) = @_;
784              
785             # Builder
786 2         9 my $builder = $self->builder;
787              
788 2         11 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
789              
790 2         15 my $source = '';
791              
792 2         10 $source .= "static void SPVM_BOOTSTRAP_create_bootstrap_set_precompile_method_addresses(SPVM_ENV* env){\n";
793              
794 2         10 for my $basic_type_name (@$basic_type_names) {
795 28         100 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
796            
797 28         59 my $method_cname = $basic_type_name;
798 28         84 $method_cname =~ s/::/__/g;
799            
800 28         146 my $precompile_method_names = $basic_type->_get_precompile_method_names;
801            
802 28         95 for my $precompile_method_name (@$precompile_method_names) {
803 5         19 $source .= <<"EOS";
804             SPVM_BOOTSTRAP_set_precompile_method_address(env, "$basic_type_name", "$precompile_method_name", &SPVMPRECOMPILE__${method_cname}__$precompile_method_name);
805             EOS
806             }
807             }
808              
809 2         186 $source .= "}\n";
810            
811 2         47 return $source;
812             }
813              
814             sub create_bootstrap_set_native_method_addresses_func_source {
815 2     2 0 10 my ($self) = @_;
816              
817             # Builder
818 2         7 my $builder = $self->builder;
819              
820 2         8 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
821              
822 2         19 my $source = '';
823              
824 2         11 $source .= "static void SPVM_BOOTSTRAP_create_bootstrap_set_native_method_addresses(SPVM_ENV* env){\n";
825              
826 2         10 for my $basic_type_name (@$basic_type_names) {
827 28         95 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
828            
829 28         52 my $method_cname = $basic_type_name;
830 28         82 $method_cname =~ s/::/__/g;
831            
832 28         170 my $native_method_names = $basic_type->_get_native_method_names;
833            
834 28         91 for my $native_method_name (@$native_method_names) {
835 4         11 $source .= <<"EOS";
836             SPVM_BOOTSTRAP_set_native_method_address(env, "$basic_type_name", "$native_method_name", &SPVM__${method_cname}__$native_method_name);
837             EOS
838             }
839             }
840              
841 2         201 $source .= "}\n";
842            
843 2         35 return $source;
844             }
845              
846             sub create_bootstrap_source {
847 2     2 0 17 my ($self) = @_;
848            
849             # Builder
850 2         32 my $builder = $self->builder;
851            
852 2         27 my $basic_type_name = $self->class_name;
853            
854 2         28 my $basic_type_names = $self->runtime->_get_user_defined_basic_type_names;
855            
856 2         9 my $class_files = [];
857 2         28 for my $basic_type_name (@$basic_type_names) {
858 28         105 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
859 28 100       157 if ($basic_type->get_class_dir) {
860 4         31 my $class_file = $basic_type->_get_class_file;
861 4         135 push @$class_files, $class_file;
862             }
863             }
864            
865             # Source file - Output
866 2         330 my $build_src_dir = SPVM::Builder::Util::create_build_src_path($self->builder->build_dir);
867 2         16 my $target_perl_basic_type_name = "SPVM::$basic_type_name";
868 2         7 my $bootstrap_base = $target_perl_basic_type_name;
869 2         32 $bootstrap_base =~ s|::|/|g;
870 2         16 my $bootstrap_source_file = "$build_src_dir/$bootstrap_base.boot.c";
871            
872             # Source creating callback
873             my $create_cb = sub {
874            
875 2     2   10 my $bootstrap_source = '';
876            
877             # Header
878 2         27 $bootstrap_source .= $self->create_bootstrap_header_source;
879            
880             # main function
881 2         13 $bootstrap_source .= $self->create_bootstrap_main_func_source;
882            
883             # Set precompile method addresses function
884 2         19 my $config_exe = $self->config;
885 2         23 $bootstrap_source .= $self->create_bootstrap_set_precompile_method_addresses_func_source;
886            
887             # Set native method addresses function
888 2         19 $bootstrap_source .= $self->create_bootstrap_set_native_method_addresses_func_source;
889            
890 2         13 $bootstrap_source .= $self->create_bootstrap_get_runtime_source;
891            
892             # Build source directory
893 2         14 my $build_src_dir = SPVM::Builder::Util::create_build_src_path($self->builder->build_dir);
894 2         144 mkpath $build_src_dir;
895 2         394 mkpath dirname $bootstrap_source_file;
896            
897 2 50       284 open my $bootstrap_source_fh, '>', $bootstrap_source_file
898             or die "Can't open file $bootstrap_source_file:$!";
899            
900 2         275 print $bootstrap_source_fh $bootstrap_source;
901 2         44 };
902            
903             # Create source file
904 2         37 $self->create_source_file({
905             input_files => [@$class_files, __FILE__],
906             output_file => $bootstrap_source_file,
907             create_cb => $create_cb,
908             });
909             }
910              
911             sub compile_bootstrap_source_file {
912 2     2 0 10 my ($self) = @_;
913            
914 2         9 my $config_exe = $self->config;
915            
916             # Target class name
917 2         7 my $basic_type_name = $self->class_name;
918            
919 2         9 my $target_perl_basic_type_name = "SPVM::$basic_type_name";
920            
921             # Compile source files
922 2         32 my $basic_type_name_rel_file = SPVM::Builder::Util::convert_basic_type_name_to_rel_file($target_perl_basic_type_name);
923 2         10 my $object_file_name = SPVM::Builder::Util::create_build_object_path($self->builder->build_dir, "$basic_type_name_rel_file.boot.o");
924 2         9 my $source_file = SPVM::Builder::Util::create_build_src_path($self->builder->build_dir, "$basic_type_name_rel_file.boot.c");
925            
926             # Create directory for object file output
927 2         152 mkdir dirname $object_file_name;
928            
929 2         32 my $config = $config_exe->config_bootstrap;
930 2 50       10 unless ($config) {
931 0         0 confess "The config_bootstrap field in the SPVM::Builder::Config class must be defined";
932             }
933            
934             # Compile
935 2         27 my $object_file = $self->compile_source_file({
936             source_file => $source_file,
937             output_file => $object_file_name,
938             config => $config,
939             });
940            
941 2         119 return $object_file;
942             }
943              
944             sub compile_spvm_core_source_files {
945 2     2 0 7 my ($self) = @_;
946            
947             # Config
948 2         13 my $config_exe = $self->config;
949            
950 2         8 my $builder_dir = SPVM::Builder::Util::get_builder_dir_from_config_class();
951            
952             # SPVM src directory
953 2         8 my $builder_src_dir = "$builder_dir/src";
954            
955             # SPVM runtime source files
956 2         4 my $spvm_runtime_src_base_names;
957 2         18 $spvm_runtime_src_base_names = SPVM::Builder::Util::get_spvm_core_source_file_names();
958 2         8 my @spvm_core_source_files = map { "$builder_src_dir/$_" } @$spvm_runtime_src_base_names;
  106         206  
959            
960             # Object dir
961 2         10 my $output_dir = SPVM::Builder::Util::create_build_object_path($self->builder->build_dir);
962 2         197 mkpath $output_dir;
963            
964             # Config
965 2         23 my $config = $config_exe->config_spvm_core;
966 2 50       12 unless ($config) {
967 0         0 confess "The config_spvm_core field in the SPVM::Builder::Config module must be defined";
968             }
969            
970             # Compile source files
971 2         6 my $object_files = [];
972 2         8 for my $src_file (@spvm_core_source_files) {
973             # Object file
974 106         11540 my $object_file_name = "$output_dir/" . basename($src_file);
975 106         1229 $object_file_name =~ s/\.c$//;
976 106         287 $object_file_name .= '.o';
977            
978 106         995 my $object_file = $self->compile_source_file({
979             source_file => $src_file,
980             output_file => $object_file_name,
981             config => $config,
982             });
983 106         1431 push @$object_files, $object_file;
984             }
985            
986 2         116 return $object_files;
987             }
988              
989             sub compile_module_precompile_source_file {
990 28     28 0 72 my ($self, $basic_type_name) = @_;
991              
992 28         88 my $config_exe = $self->config;
993            
994             # Builer
995 28         89 my $builder = $self->builder;
996            
997             # Build directory
998 28         66 my $build_dir = $self->builder->build_dir;
999            
1000             # Build precompile modules
1001 28         85 my $builder_cc = SPVM::Builder::CC->new(
1002             build_dir => $build_dir,
1003             quiet => $self->quiet,
1004             force => $self->force,
1005             );
1006            
1007 28         56 my $object_files = [];
1008 28         78 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
1009 28         175 my $precompile_method_names = $basic_type->_get_precompile_method_names;
1010 28 100       114 if (@$precompile_method_names) {
1011 2         9 my $build_src_dir = SPVM::Builder::Util::create_build_src_path($self->builder->build_dir);
1012 2         385 mkpath $build_src_dir;
1013            
1014 2         24 my $class_file = $basic_type->_get_class_file;
1015 2         9 my $precompile_source = $self->runtime->build_precompile_module_source($basic_type);
1016            
1017 2         44 $builder_cc->build_precompile_module_source_file(
1018             $basic_type_name,
1019             {
1020             output_dir => $build_src_dir,
1021             precompile_source => $precompile_source,
1022             class_file => $class_file,
1023             }
1024             );
1025            
1026 2         15 my $build_object_dir = SPVM::Builder::Util::create_build_object_path($self->builder->build_dir);
1027 2         70 mkpath $build_object_dir;
1028            
1029 2         22 my $config = SPVM::Builder::Util::API::create_default_config();
1030 2         34 my $before_each_compile_cbs = $config_exe->before_each_compile_cbs;
1031 2         25 $config->add_before_compile_cb(@$before_each_compile_cbs);
1032 2         38 my $precompile_object_files = $builder_cc->compile_source_files(
1033             $basic_type_name,
1034             {
1035             input_dir => $build_src_dir,
1036             output_dir => $build_object_dir,
1037             config => $config,
1038             category => 'precompile',
1039             }
1040             );
1041 2         533 push @$object_files, @$precompile_object_files;
1042             }
1043            
1044 28         1020 return $object_files;
1045             }
1046              
1047             sub compile_module_native_source_files {
1048 28     28 0 72 my ($self, $basic_type_name) = @_;
1049              
1050 28         95 my $config_exe = $self->config;
1051            
1052 28         98 my $builder = $self->builder;
1053              
1054             # Build directory
1055 28         66 my $build_dir = $self->builder->build_dir;
1056 28         1081 mkpath $build_dir;
1057              
1058             # Compiler for native class
1059 28         144 my $builder_cc = SPVM::Builder::CC->new(
1060             build_dir => $build_dir,
1061             quiet => $self->quiet,
1062             force => $self->force,
1063             );
1064            
1065 28         56 my $all_object_files = [];
1066            
1067 28         227 my $perl_basic_type_name = "SPVM::$basic_type_name";
1068            
1069 28         133 my $basic_type = $self->runtime->get_basic_type_by_name($basic_type_name);
1070            
1071 28         163 my $native_method_names = $basic_type->_get_native_method_names;
1072 28 100       128 if (@$native_method_names) {
1073 1         37 my $class_file = $basic_type->_get_class_file;
1074 1         14 my $native_dir = $class_file;
1075            
1076 1         16 $native_dir =~ s/\.spvm$//;
1077 1         12 $native_dir .= 'native';
1078 1         24 my $input_dir = SPVM::Builder::Util::remove_basic_type_name_part_from_file($class_file, $perl_basic_type_name);
1079 1         16 my $build_object_dir = SPVM::Builder::Util::create_build_object_path($self->builder->build_dir);
1080 1         52 mkpath $build_object_dir;
1081              
1082 1 50       13 unless (defined $class_file) {
1083 0         0 my $config_file = SPVM::Builder::Util::get_config_file_from_basic_type_name($basic_type_name);
1084 0 0       0 if ($config_file) {
1085 0         0 $class_file = $config_file;
1086 0         0 $class_file =~ s/\.config$/\.spvm/;
1087             }
1088             else {
1089 0         0 confess "The class file \"$class_file\" is not loaded";
1090             }
1091             }
1092 1         19 my $config = $builder->create_native_config_from_class_file($class_file);
1093 1         192 my $before_each_compile_cbs = $config_exe->before_each_compile_cbs;
1094 1         6 $config->add_before_compile_cb(@$before_each_compile_cbs);
1095            
1096 1         2 my $resource_include_dirs = [];
1097 1         4 my $config_exe = $self->config;
1098 1         24 my $resource_names = $config_exe->get_resource_names;
1099 1         11 for my $resource_name (@$resource_names) {
1100 2         13 my $resource = $config_exe->get_resource($resource_name);
1101 2         7 my $resource_include_dir = $resource->config->native_include_dir;
1102 2         7 push @$resource_include_dirs, $resource_include_dir;
1103             }
1104 1         12 $config->add_include_dir(@$resource_include_dirs);
1105            
1106 1         5 $config->disable_resource(1);
1107 1         22 my $object_files = $builder_cc->compile_source_files(
1108             $basic_type_name,
1109             {
1110             input_dir => $input_dir,
1111             output_dir => $build_object_dir,
1112             config => $config,
1113             category => 'native',
1114             }
1115             );
1116 1         380 push @$all_object_files, @$object_files;
1117             }
1118            
1119 28         867 return $all_object_files;
1120             }
1121              
1122             1;
1123              
1124             =head1 Name
1125              
1126             SPVM::Builder::Exe - Creating Executable File
1127              
1128             =head1 Copyright & License
1129              
1130             Copyright (c) 2023 Yuki Kimoto
1131              
1132             MIT License