File Coverage

blib/lib/SPVM/Builder/Exe.pm
Criterion Covered Total %
statement 405 502 80.6
branch 32 72 44.4
condition 2 8 25.0
subroutine 45 50 90.0
pod 0 28 0.0
total 484 660 73.3


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