?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
tagged release 0.7.1
[parrot.git] / compilers / imcc / main.c
blob40eb6f22f7ffbedfde306813b1fd33d8aab7a11b
1 /*
2 * $Id$
3 *
4 * Intermediate Code Compiler for Parrot.
5 *
6 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
7 * Copyright (C) 2003-2008, The Perl Foundation.
8 */
9
10 /*
11
12 =head1 NAME
13
14 compilers/imcc/main.c
15
16 =head1 DESCRIPTION
17
18 IMCC helpers.
19
20 =head2 Functions
21
22 =over 4
23
24 =cut
25
26 */
27
28 #include <string.h>
29 #include <stdio.h>
30 #include <stdlib.h>
31
32 #include "imc.h"
33 #include "parrot/embed.h"
34 #include "parrot/longopt.h"
35 #include "parrot/imcc.h"
36 #include "pbc.h"
37 #include "parser.h"
38
39 extern int yydebug;
40
41 /* HEADERIZER HFILE: none */
42
43 /* HEADERIZER BEGIN: static */
44 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
45
46 static void compile_to_bytecode(PARROT_INTERP,
47 ARGIN(const char * const sourcefile),
48 ARGIN(const char * const output_file))
49 __attribute__nonnull__(1)
50 __attribute__nonnull__(2)
51 __attribute__nonnull__(3);
52
53 static void determine_input_file_type(PARROT_INTERP,
54 ARGIN(const char * const sourcefile))
55 __attribute__nonnull__(1)
56 __attribute__nonnull__(2);
57
58 static void determine_output_file_type(PARROT_INTERP,
59 ARGMOD(int *obj_file),
60 ARGIN(const char *output_file))
61 __attribute__nonnull__(1)
62 __attribute__nonnull__(2)
63 __attribute__nonnull__(3)
64 FUNC_MODIFIES(*obj_file);
65
66 static void do_pre_process(PARROT_INTERP)
67 __attribute__nonnull__(1);
68
69 static void help(void);
70 static void help_debug(void);
71 static void imcc_get_optimization_description(
72 const PARROT_INTERP,
73 int opt_level,
74 ARGMOD(char *opt_desc))
75 __attribute__nonnull__(3)
76 FUNC_MODIFIES(*opt_desc);
77
78 static void imcc_run_pbc(PARROT_INTERP,
79 int obj_file,
80 ARGIN(const char *output_file),
81 int argc,
82 ARGIN(char **argv))
83 __attribute__nonnull__(1)
84 __attribute__nonnull__(3)
85 __attribute__nonnull__(5);
86
87 static void imcc_write_pbc(PARROT_INTERP, ARGIN(const char *output_file))
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2);
90
91 PARROT_WARN_UNUSED_RESULT
92 PARROT_PURE_FUNCTION
93 static int is_all_hex_digits(ARGIN(const char *s))
94 __attribute__nonnull__(1);
95
96 static void Parrot_version(PARROT_INTERP)
97 __attribute__nonnull__(1);
98
99 static void usage(ARGMOD(FILE* fp))
100 __attribute__nonnull__(1)
101 FUNC_MODIFIES(* fp);
102
103 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
104 /* HEADERIZER END: static */
105
106
107 static int load_pbc, run_pbc, write_pbc, pre_process_only, pasm_file;
108
109 /*
110
111 =item C<static void usage>
112
113 Outputs usage error message.
114
115 =cut
116
117 */
118
119 static void
120 usage(ARGMOD(FILE* fp))
121 {
122 fprintf(fp,
123 "parrot -[abcCEfgGhjprStvVwy.] [-d [FLAGS]] [-D [FLAGS]]"
124 "[-O [level]] [-o FILE] <file>\n");
125 }
126
127 /*
128
129 =item C<static void help_debug>
130
131 Print out list of debugging flag values.
132
133 =cut
134
135 */
136
137 static void
138 help_debug(void)
139 {
140 /* split printf for C89 compliance on string length */
141 printf(
142 "--imcc-debug -d [Flags] ...\n"
143 " 0002 lexer\n"
144 " 0004 parser\n"
145 " 0008 imc\n"
146 " 0010 CFG\n"
147 " 0020 optimization 1\n"
148 " 0040 optimization 2\n"
149 " 0100 AST\n"
150 " 1000 PBC\n"
151 " 2000 PBC constants\n"
152 " 4000 PBC fixups\n"
153 "\n");
154 printf(
155 "--parrot-debug -D [Flags] ...\n"
156 " 0001 memory statistics\n"
157 " 0002 print backtrace on exception\n"
158 " 0004 JIT debugging\n"
159 " 0008 interpreter startup\n"
160 " 0010 thread debugging\n"
161 " 0020 eval/compile\n"
162 " 0040 fill I, N registers with garbage\n"
163 " 0080 show when a context is destroyed\n"
164 "\n"
165 "--trace -t [Flags] ...\n"
166 " 0001 opcodes\n"
167 " 0002 find_method\n"
168 " 0004 function calls\n");
169 }
170
171 /*
172
173 =item C<static void help>
174
175 Print out "help" list of options.
176
177 =cut
178
179 */
180
181 static void
182 help(void)
183 {
184 /* split printf for C89 compliance on string length */
185 printf(
186 "parrot [Options] <file>\n"
187 " Options:\n"
188 " -h --help\n"
189 " -V --version\n"
190 " -I add path to include search\n"
191 " -L add path to library search\n"
192 " <Run core options>\n"
193 " -R --runcore CORE\n"
194 " -b --bounds-checks|--slow-core\n"
195 " -C --CGP-core\n"
196 " -f --fast-core\n"
197 " -g --computed-goto-core\n"
198 " -j --jit-core\n"
199 " -p --profile\n"
200 " -S --switched-core\n"
201 " -t --trace [flags]\n"
202 " <VM options>\n"
203 " -D --parrot-debug[=HEXFLAGS]\n"
204 " --help-debug\n");
205 printf(
206 " -w --warnings\n"
207 " -G --no-gc\n"
208 " --gc-debug\n"
209 " --leak-test|--destroy-at-end\n"
210 " -. --wait Read a keystroke before starting\n"
211 " --runtime-prefix\n"
212 " <Compiler options>\n"
213 " -d --imcc-debug[=HEXFLAGS]\n"
214 " -v --verbose\n"
215 " -E --pre-process-only\n"
216 " -o --output=FILE\n"
217 " --output-pbc\n"
218 " -O --optimize[=LEVEL]\n"
219 " -a --pasm\n"
220 " -c --pbc\n"
221 " -r --run-pbc\n"
222 " -y --yydebug\n"
223 " <Language options>\n"
224 "see docs/running.pod for more\n");
225 }
226
227
228 /*
229
230 =item C<static void Parrot_version>
231
232 Print out parrot version number.
233
234 =cut
235
236 */
237
238 static void
239 Parrot_version(PARROT_INTERP)
240 {
241 printf("This is parrot version " PARROT_VERSION);
242 printf(" built for " PARROT_ARCHNAME ".\n");
243 printf("Copyright (C) 2001-2008, The Perl Foundation.\n\
244 \n\
245 This code is distributed under the terms of the Artistic License 2.0.\
246 \n\
247 For more details, see the full text of the license in the LICENSE file\
248 \n\
249 included in the Parrot source tree.\n\n");
250
251 Parrot_exit(interp, 0);
252 }
253
254 #define SET_FLAG(flag) Parrot_set_flag(interp, (flag))
255 #define SET_DEBUG(flag) Parrot_set_debug(interp, (flag))
256 #define SET_TRACE(flag) Parrot_set_trace(interp, (flag))
257 #define SET_CORE(core) interp->run_core |= (core)
258
259 #define OPT_GC_DEBUG 128
260 #define OPT_DESTROY_FLAG 129
261 #define OPT_HELP_DEBUG 130
262 #define OPT_PBC_OUTPUT 131
263 #define OPT_RUNTIME_PREFIX 132
264
265 static struct longopt_opt_decl options[] = {
266 { '.', '.', (OPTION_flags)0, { "--wait" } },
267 { 'C', 'C', (OPTION_flags)0, { "--CGP-core" } },
268 { 'D', 'D', OPTION_optional_FLAG, { "--parrot-debug" } },
269 { 'E', 'E', (OPTION_flags)0, { "--pre-process-only" } },
270 { 'G', 'G', (OPTION_flags)0, { "--no-gc" } },
271 { 'I', 'I', OPTION_required_FLAG, { NULL } },
272 { 'L', 'L', OPTION_required_FLAG, { NULL } },
273 { 'O', 'O', OPTION_optional_FLAG, { "--optimize" } },
274 { 'R', 'R', OPTION_required_FLAG, { "--runcore" } },
275 { 'S', 'S', (OPTION_flags)0, { "--switched-core" } },
276 { 'V', 'V', (OPTION_flags)0, { "--version" } },
277 { '\0', OPT_DESTROY_FLAG, (OPTION_flags)0,
278 { "--leak-test", "--destroy-at-end" } },
279 { '\0', OPT_GC_DEBUG, (OPTION_flags)0, { "--gc-debug" } },
280 { 'a', 'a', (OPTION_flags)0, { "--pasm" } },
281 { 'b', 'b', (OPTION_flags)0, { "--bounds-checks", "--slow-core" } },
282 { 'c', 'c', (OPTION_flags)0, { "--pbc" } },
283 { 'd', 'd', OPTION_optional_FLAG, { "--imcc-debug" } },
284 { '\0', OPT_HELP_DEBUG, (OPTION_flags)0, { "--help-debug" } },
285 { 'f', 'f', (OPTION_flags)0, { "--fast-core" } },
286 { 'g', 'g', (OPTION_flags)0, { "--computed-goto-core" } },
287 { 'h', 'h', (OPTION_flags)0, { "--help" } },
288 { 'j', 'j', (OPTION_flags)0, { "--jit-core" } },
289 { 'o', 'o', OPTION_required_FLAG, { "--output" } },
290 { '\0', OPT_PBC_OUTPUT, (OPTION_flags)0, { "--output-pbc" } },
291 { 'p', 'p', (OPTION_flags)0, { "--profile" } },
292 { 'r', 'r', (OPTION_flags)0, { "--run-pbc" } },
293 { '\0', OPT_RUNTIME_PREFIX, (OPTION_flags)0, { "--runtime-prefix" } },
294 { 't', 't', OPTION_optional_FLAG, { "--trace" } },
295 { 'v', 'v', (OPTION_flags)0, { "--verbose" } },
296 { 'w', 'w', (OPTION_flags)0, { "--warnings" } },
297 { 'y', 'y', (OPTION_flags)0, { "--yydebug" } },
298 { 0, 0, (OPTION_flags)0, { NULL } }
299 };
300
301 /*
302
303 =item C<static int is_all_hex_digits>
304
305 Tests all characters in a string are hexadecimal digits.
306 Returns 1 if true, 0 as soon as a non-hex found
307
308 =cut
309
310 */
311
312 PARROT_WARN_UNUSED_RESULT
313 PARROT_PURE_FUNCTION
314 static int
315 is_all_hex_digits(ARGIN(const char *s))
316 {
317 for (; *s; s++)
318 if (!isxdigit(*s))
319 return 0;
320 return 1;
321 }
322
323 /*
324
325 =item C<const char * parseflags>
326
327 Parse Parrot's command line for options and set appropriate flags.
328
329 =cut
330
331 */
332
333 PARROT_WARN_UNUSED_RESULT
334 PARROT_CAN_RETURN_NULL
335 const char *
336 parseflags(PARROT_INTERP, int *argc, char **argv[])
337 {
338 struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
339 int status;
340 if (*argc == 1) {
341 usage(stderr);
342 exit(EXIT_SUCCESS);
343 }
344 run_pbc = 1;
345
346 while ((status = longopt_get(interp, *argc, (const char **)*argv, options,
347 &opt)) > 0) {
348 switch (opt.opt_id) {
349 case 'R':
350 if (STREQ(opt.opt_arg, "slow") || STREQ(opt.opt_arg, "bounds"))
351 SET_CORE(PARROT_SLOW_CORE);
352 else if (STREQ(opt.opt_arg, "fast") || STREQ(opt.opt_arg, "function"))
353 SET_CORE(PARROT_FAST_CORE);
354 else if (STREQ(opt.opt_arg, "switch"))
355 SET_CORE(PARROT_SWITCH_CORE);
356 else if (STREQ(opt.opt_arg, "cgp"))
357 SET_CORE(PARROT_CGP_CORE);
358 else if (STREQ(opt.opt_arg, "cgoto"))
359 SET_CORE(PARROT_CGOTO_CORE);
360 else if (STREQ(opt.opt_arg, "jit"))
361 SET_CORE(PARROT_JIT_CORE);
362 else if (STREQ(opt.opt_arg, "cgp-jit"))
363 SET_CORE(PARROT_CGP_JIT_CORE);
364 else if (STREQ(opt.opt_arg, "switch-jit"))
365 SET_CORE(PARROT_SWITCH_JIT_CORE);
366 else if (STREQ(opt.opt_arg, "exec"))
367 SET_CORE(PARROT_EXEC_CORE);
368 else if (STREQ(opt.opt_arg, "trace")) {
369 SET_CORE(PARROT_SLOW_CORE);
370 #ifdef HAVE_COMPUTED_GOTO
371 SET_CORE(PARROT_CGP_CORE);
372 #endif
373 #if JIT_CAPABLE
374 SET_CORE(PARROT_JIT_CORE);
375 #endif
376 }
377 else if (STREQ(opt.opt_arg, "gcdebug"))
378 SET_CORE(PARROT_GC_DEBUG_CORE);
379 else
380 Parrot_ex_throw_from_c_args(interp, NULL, 1,
381 "main: Unrecognized runcore '%s' specified."
382 "\n\nhelp: parrot -h\n", opt.opt_arg);
383 break;
384 case 'b':
385 SET_FLAG(PARROT_BOUNDS_FLAG);
386 break;
387 case 'p':
388 SET_FLAG(PARROT_PROFILE_FLAG);
389 break;
390 case 't':
391 if (opt.opt_arg && is_all_hex_digits(opt.opt_arg))
392 SET_TRACE(strtoul(opt.opt_arg, 0, 16));
393 else
394 SET_TRACE(PARROT_TRACE_OPS_FLAG);
395 break;
396 case 'j':
397 SET_CORE(PARROT_JIT_CORE);
398 break;
399 case 'S':
400 SET_CORE(PARROT_SWITCH_CORE);
401 break;
402 case 'C':
403 SET_CORE(PARROT_CGP_CORE);
404 break;
405 case 'f':
406 SET_CORE(PARROT_FAST_CORE);
407 break;
408 case 'g':
409 SET_CORE(PARROT_CGOTO_CORE);
410 break;
411 case 'd':
412 if (opt.opt_arg && is_all_hex_digits(opt.opt_arg)) {
413 IMCC_INFO(interp)->debug = strtoul(opt.opt_arg, 0, 16);
414 }
415 else {
416 IMCC_INFO(interp)->debug++;
417 }
418 break;
419 case 'D':
420 if (opt.opt_arg && is_all_hex_digits(opt.opt_arg)) {
421 SET_DEBUG(strtoul(opt.opt_arg, 0, 16));
422 }
423 else
424 SET_DEBUG(PARROT_MEM_STAT_DEBUG_FLAG);
425 break;
426 case 'w':
427 Parrot_setwarnings(interp, PARROT_WARNINGS_ALL_FLAG);
428 IMCC_INFO(interp)->imcc_warn = 1;
429 break;
430 case 'G':
431 IMCC_INFO(interp)->gc_off = 1;
432 break;
433 case '.': /* Give Windows Parrot hackers an opportunity to
434 * attach a debuggger. */
435 fgetc(stdin);
436 break;
437 case 'a':
438 pasm_file = 1;
439 break;
440 case 'h':
441 help();
442 exit(EX_USAGE);
443 break;
444 case OPT_HELP_DEBUG:
445 help_debug();
446 exit(EX_USAGE);
447 break;
448 case OPT_RUNTIME_PREFIX:
449 {
450 char *prefix = Parrot_get_runtime_prefix(interp);
451 printf("%s\n", prefix);
452 free(prefix);
453 exit(EXIT_SUCCESS);
454 }
455 break;
456 case 'V':
457 Parrot_version(interp);
458 break;
459 case 'r':
460 ++run_pbc;
461 break;
462 case 'c':
463 load_pbc = 1;
464 break;
465 case 'v':
466 IMCC_INFO(interp)->verbose++;
467 break;
468 case 'y':
469 yydebug = 1;
470 break;
471 case 'E':
472 pre_process_only = 1;
473 break;
474 case 'o':
475 run_pbc = 0;
476 interp->output_file = opt.opt_arg;
477 break;
478
479 case OPT_PBC_OUTPUT:
480 run_pbc = 0;
481 write_pbc = 1;
482 if (!interp->output_file)
483 interp->output_file = "-";
484 break;
485
486 case 'O':
487 if (!opt.opt_arg) {
488 IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
489 break;
490 }
491 if (strchr(opt.opt_arg, 'p'))
492 IMCC_INFO(interp)->optimizer_level |= OPT_PASM;
493 if (strchr(opt.opt_arg, 'c'))
494 IMCC_INFO(interp)->optimizer_level |= OPT_SUB;
495
496 IMCC_INFO(interp)->allocator = IMCC_GRAPH_ALLOCATOR;
497 /* currently not ok due to different register allocation */
498 if (strchr(opt.opt_arg, 'j')) {
499 SET_CORE(PARROT_JIT_CORE);
500 }
501 if (strchr(opt.opt_arg, '1')) {
502 IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
503 }
504 if (strchr(opt.opt_arg, '2')) {
505 IMCC_INFO(interp)->optimizer_level |= (OPT_PRE | OPT_CFG);
506 }
507 if (strchr(opt.opt_arg, 't')) {
508 SET_CORE(PARROT_SWITCH_CORE);
509 #ifdef HAVE_COMPUTED_GOTO
510 SET_CORE(PARROT_CGP_CORE);
511 #endif
512 #if JIT_CAPABLE
513 SET_CORE(PARROT_JIT_CORE);
514 #endif
515 }
516 break;
517
518 case OPT_GC_DEBUG:
519 #if DISABLE_GC_DEBUG
520 Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG,
521 "PARROT_GC_DEBUG is set but the binary was "
522 "compiled with DISABLE_GC_DEBUG.");
523 #endif
524 SET_FLAG(PARROT_GC_DEBUG_FLAG);
525 break;
526 case OPT_DESTROY_FLAG:
527 SET_FLAG(PARROT_DESTROY_FLAG);
528 break;
529 case 'I':
530 Parrot_add_library_path(interp, opt.opt_arg,
531 PARROT_LIB_PATH_INCLUDE);
532 break;
533 case 'L':
534 Parrot_add_library_path(interp, opt.opt_arg,
535 PARROT_LIB_PATH_LIBRARY);
536 break;
537 default:
538 Parrot_ex_throw_from_c_args(interp, NULL, 1,
539 "main: Invalid flag '%s' used.\n\nhelp: parrot -h\n",
540 (*argv)[0]);
541 }
542 }
543 if (status == -1) {
544 fprintf(stderr, "%s\n", opt.opt_error);
545 usage(stderr);
546 exit(EX_USAGE);
547 }
548 /* reached the end of the option list and consumed all of argv */
549 if (*argc == opt.opt_index) {
550 if (interp->output_file) {
551 fprintf(stderr, "Missing program name or argument for -o\n");
552 }
553 else {
554 /* We are not looking at an option, so it must be a program name */
555 fprintf(stderr, "Missing program name\n");
556 }
557 usage(stderr);
558 exit(EX_USAGE);
559 }
560 *argc -= opt.opt_index;
561 *argv += opt.opt_index;
562
563 return (*argv)[0];
564 }
565
566 /*
567
568 =item C<static void do_pre_process>
569
570 Pre-processor step. Turn parser's output codes into Parrot instructions.
571
572 =cut
573
574 */
575
576 static void
577 do_pre_process(PARROT_INTERP)
578 {
579 int c;
580 YYSTYPE val;
581
582 const yyscan_t yyscanner = IMCC_INFO(interp)->yyscanner;
583
584 IMCC_push_parser_state(interp);
585 c = yylex(&val, yyscanner, interp); /* is reset at end of while loop */
586 while (c) {
587 switch (c) {
588 case EMIT: printf(".emit\n"); break;
589 case EOM: printf(".eom\n"); break;
590 case LOCAL: printf(".local "); break;
591 case ARG: printf(".arg "); break;
592 case SUB: printf(".sub "); break;
593 case ESUB: printf(".end"); break;
594 case RESULT: printf(".result "); break;
595 case RETURN: printf(".return "); break;
596 case NAMESPACE: printf(".namespace "); break;
597 case ENDNAMESPACE: printf(".endnamespace"); break;
598 case CONST: printf(".const "); break;
599 case PARAM: printf(".param "); break;
600 /* RT#46147: print out more information about the macro */
601 /* case MACRO: yylex(&val, interp, yyscanner);
602 break; */ /* swallow nl */
603 case MACRO: printf(".macro "); break;
604
605 case GOTO: printf("goto ");break;
606 case IF: printf("if ");break;
607 case UNLESS: printf("unless ");break;
608 case INC: printf("inc ");break;
609 case DEC: printf("dec ");break;
610 case INTV: printf("int ");break;
611 case FLOATV: printf("float ");break;
612 case STRINGV: printf("string ");break;
613 case PMCV: printf("pmc ");break;
614 case NEW: printf("new ");break;
615 case ADDR: printf("addr ");break;
616 case GLOBAL: printf("global ");break;
617 case SHIFT_LEFT: printf(" << ");break;
618 case SHIFT_RIGHT: printf(" >> ");break;
619 case SHIFT_RIGHT_U: printf(" >>> ");break;
620 case LOG_AND: printf(" && ");break;
621 case LOG_OR: printf(" || ");break;
622 case LOG_XOR: printf(" ~~ ");break;
623 case RELOP_LT: printf(" < ");break;
624 case RELOP_LTE: printf(" <= ");break;
625 case RELOP_GT: printf(" > ");break;
626 case RELOP_GTE: printf(" >= ");break;
627 case RELOP_EQ: printf(" == ");break;
628 case RELOP_NE: printf(" != ");break;
629 case POW: printf(" ** ");break;
630 case COMMA: printf(", ");break;
631 case LABEL: printf("%s:\t", val.s); break;
632 case PCC_BEGIN: printf(".begin_call "); break;
633 case PCC_END: printf(".end_call"); break;
634 case PCC_SUB: printf(".pccsub "); break;
635 case PCC_CALL: printf(".call "); break;
636 case PCC_BEGIN_RETURN: printf(".begin_return"); break;
637 case PCC_END_RETURN: printf(".end_return"); break;
638 case PCC_BEGIN_YIELD: printf(".begin_yield"); break;
639 case PCC_END_YIELD: printf(".end_yield"); break;
640 case FILECOMMENT: printf("setfile \"%s\"\n", val.s); break;
641 case LINECOMMENT: printf("setline %d\n", val.t); break;
642
643 case PLUS_ASSIGN: printf("+= ");break;
644 case MINUS_ASSIGN: printf("-= ");break;
645 case MUL_ASSIGN: printf("*= ");break;
646 case DIV_ASSIGN: printf("/= ");break;
647 case MOD_ASSIGN: printf("%%= ");break;
648 case FDIV_ASSIGN: printf("//= ");break;
649 case BAND_ASSIGN: printf("&= ");break;
650 case BOR_ASSIGN: printf("|= ");break;
651 case BXOR_ASSIGN: printf("~= ");break;
652 case SHR_ASSIGN: printf(">>= ");break;
653 case SHL_ASSIGN: printf("<<= ");break;
654 case SHR_U_ASSIGN: printf(">>>= ");break;
655 case CONCAT_ASSIGN: printf(".= ");break;
656
657 case MAIN: printf(":main");break;
658 case LOAD: printf(":load");break;
659 case INIT: printf(":init");break;
660 case IMMEDIATE: printf(":immediate");break;
661 case POSTCOMP: printf(":postcomp");break;
662 case ANON: printf(":anon");break;
663 case OUTER: printf(":outer");break;
664 case NEED_LEX: printf(":lex");break;
665 case METHOD: printf(":method");break;
666
667 case UNIQUE_REG: printf(":unique_reg");break;
668 case ADV_FLAT: printf(":flat");break;
669 case ADV_SLURPY: printf(":slurpy");break;
670 case ADV_OPTIONAL: printf(":optional");break;
671 case ADV_OPT_FLAG: printf(":opt_flag");break;
672 case ADV_NAMED: printf(":named");break;
673 case ADV_ARROW: printf("=>");break;
674
675 default:
676 if (c < 255)
677 printf("%c", c);
678 else
679 printf("%s ", val.s);
680 break;
681 }
682 c = yylex(&val, yyscanner, interp);
683 }
684 printf("\n");
685 fflush(stdout);
686
687 return;
688 }
689
690 /*
691
692 =item C<static void imcc_get_optimization_description>
693
694 Create list (opt_desc[]) describing optimisation flags.
695
696 =cut
697
698 */
699
700 static void
701 imcc_get_optimization_description(const PARROT_INTERP, int opt_level, ARGMOD(char *opt_desc))
702 {
703 int i = 0;
704
705 if (opt_level & (OPT_PRE | OPT_CFG))
706 opt_desc[i++] = '2';
707 else
708 if (opt_level & OPT_PRE)
709 opt_desc[i++] = '1';
710
711 if (opt_level & OPT_PASM)
712 opt_desc[i++] = 'p';
713 if (opt_level & OPT_SUB)
714 opt_desc[i++] = 'c';
715
716 if (interp->run_core & PARROT_JIT_CORE)
717 opt_desc[i++] = 'j';
718
719 if (interp->run_core & PARROT_SWITCH_CORE)
720 opt_desc[i++] = 't';
721
722 opt_desc[i] = '\0';
723 return;
724 }
725
726 /*
727
728 =item C<void imcc_initialize>
729
730 Initialise interpreter and set optimisation level.
731
732 =cut
733
734 */
735
736 void
737 imcc_initialize(PARROT_INTERP)
738 {
739 yyscan_t yyscanner = IMCC_INFO(interp)->yyscanner;
740
741 do_yylex_init(interp, &yyscanner);
742
743 Parrot_block_GC_mark(interp);
744 Parrot_block_GC_sweep(interp);
745
746 IMCC_INFO(interp)->yyscanner = yyscanner;
747 IMCC_INFO(interp)->allocator = IMCC_VANILLA_ALLOCATOR;
748
749 /* Default optimization level is zero; see optimizer.c, imc.h */
750 if (!IMCC_INFO(interp)->optimizer_level) {
751 #if 1
752 IMCC_INFO(interp)->optimizer_level = 0;
753 #else
754 /* won't even make with this: something with Data::Dumper and
755 * set_i_p_i*/
756 IMCC_INFO(interp)->optimizer_level = OPT_PRE;
757 #endif
758 }
759 }
760
761 /*
762
763 =item C<static void imcc_run_pbc>
764
765 Write out or run Parrot bytecode.
766 RT#46149 no return value :-(
767
768 =cut
769
770 */
771
772 static void
773 imcc_run_pbc(PARROT_INTERP, int obj_file, ARGIN(const char *output_file),
774 int argc, ARGIN(char **argv))
775 {
776 if (IMCC_INFO(interp)->imcc_warn)
777 PARROT_WARNINGS_on(interp, PARROT_WARNINGS_ALL_FLAG);
778 else
779 PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
780
781 if (!IMCC_INFO(interp)->gc_off) {
782 Parrot_unblock_GC_mark(interp);
783 Parrot_unblock_GC_sweep(interp);
784 }
785
786 if (obj_file)
787 IMCC_info(interp, 1, "Writing %s\n", output_file);
788 else
789 IMCC_info(interp, 1, "Running...\n");
790
791 /* runs :init functions */
792 PackFile_fixup_subs(interp, PBC_MAIN, NULL);
793
794 /* RT#46149 no return value :-( */
795 Parrot_runcode(interp, argc, argv);
796 }
797
798 /*
799
800 =item C<static void imcc_write_pbc>
801
802 Output packed bytecode file.
803
804 =cut
805
806 */
807
808 static void
809 imcc_write_pbc(PARROT_INTERP, ARGIN(const char *output_file))
810 {
811 size_t size;
812 opcode_t *packed;
813 FILE *fp;
814
815 IMCC_info(interp, 1, "Writing %s\n", output_file);
816
817 size = PackFile_pack_size(interp, interp->code->base.pf) *
818 sizeof (opcode_t);
819 IMCC_info(interp, 1, "packed code %d bytes\n", size);
820 packed = (opcode_t*) mem_sys_allocate(size);
821 PackFile_pack(interp, interp->code->base.pf, packed);
822 if (STREQ(output_file, "-"))
823 fp = stdout;
824 else if ((fp = fopen(output_file, "wb")) == 0)
825 IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
826 "Couldn't open %s\n", output_file);
827
828 if ((1 != fwrite(packed, size, 1, fp)))
829 IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
830 "Couldn't write %s\n", output_file);
831 fclose(fp);
832 IMCC_info(interp, 1, "%s written.\n", output_file);
833 free(packed);
834 }
835
836 /*
837
838 =item C<static void determine_input_file_type>
839
840 Read in the source and determine whether it's Parrot bytecode or PASM
841
842 =cut
843
844 */
845
846 static void
847 determine_input_file_type(PARROT_INTERP, ARGIN(const char * const sourcefile))
848 {
849 yyscan_t yyscanner = IMCC_INFO(interp)->yyscanner;
850
851 /* Read in the source and check the file extension for the input type;
852 a file extension .pbc means it's parrot bytecode;
853 a file extension .pasm means it's parrot assembly (PASM);
854 otherwise, it's assumed to be PIR.
855 */
856 if (STREQ(sourcefile, "-")) {
857 imc_yyin_set(stdin, yyscanner);
858 }
859 else {
860 const char * const ext = strrchr(sourcefile, '.');
861
862 if (ext && (STREQ(ext, ".pbc"))) { /* a PBC file */
863 load_pbc = 1;
864 write_pbc = 0;
865 }
866 else if (!load_pbc) {
867 if (!(imc_yyin_set(fopen(sourcefile, "r"), yyscanner))) {
868 IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
869 "Error reading source file %s.\n",
870 sourcefile);
871 }
872 if (ext && STREQ(ext, ".pasm")) {
873 pasm_file = 1;
874 }
875 }
876 }
877 }
878
879 /*
880
881 =item C<static void determine_output_file_type>
882
883 Decide what kind of file we are to output.
884
885 =cut
886
887 */
888
889 static void
890 determine_output_file_type(PARROT_INTERP,
891 ARGMOD(int *obj_file), ARGIN(const char *output_file))
892 {
893 const char * const ext = strrchr(output_file, '.');
894
895 if (ext) {
896 if (STREQ(ext, ".pbc")) {
897 write_pbc = 1;
898 }
899 else if (STREQ(ext, PARROT_OBJ_EXT)) {
900 #if EXEC_CAPABLE
901 load_pbc = 1;
902 write_pbc = 0;
903 run_pbc = 1;
904 *obj_file = 1;
905 Parrot_set_run_core(interp, PARROT_EXEC_CORE);
906 #else
907 UNUSED(obj_file);
908 IMCC_fatal_standalone(interp, 1, "main: can't produce object file");
909 #endif
910 }
911 }
912 }
913
914 /*
915
916 =item C<static void compile_to_bytecode>
917
918 Compile source code into bytecode (or die trying).
919
920 =cut
921
922 */
923
924 static void
925 compile_to_bytecode(PARROT_INTERP,
926 ARGIN(const char * const sourcefile),
927 ARGIN(const char * const output_file))
928 {
929 yyscan_t yyscanner = IMCC_INFO(interp)->yyscanner;
930 const int per_pbc = (write_pbc | run_pbc) != 0;
931 const int opt_level = IMCC_INFO(interp)->optimizer_level;
932 PackFile *pf;
933
934 /* Shouldn't be more than five, but five extra is cheap */
935 char opt_desc[10];
936
937 imcc_get_optimization_description(interp, opt_level, opt_desc);
938
939 IMCC_info(interp, 1, "using optimization '-O%s' (%x) \n",
940 opt_desc, opt_level);
941
942 pf = PackFile_new(interp, 0);
943 Parrot_loadbc(interp, pf);
944
945 IMCC_push_parser_state(interp);
946 IMCC_INFO(interp)->state->file = sourcefile;
947
948 emit_open(interp, per_pbc, per_pbc ? NULL : (void*)output_file);
949
950 IMCC_info(interp, 1, "Starting parse...\n");
951
952 IMCC_INFO(interp)->state->pasm_file = pasm_file;
953 IMCC_TRY(IMCC_INFO(interp)->jump_buf,
954 IMCC_INFO(interp)->error_code) {
955 if (yyparse(yyscanner, interp))
956 exit(EXIT_FAILURE);
957
958 imc_compile_all_units(interp);
959 }
960 IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
961 char * const error_str = string_to_cstring(interp,
962 IMCC_INFO(interp)->error_message);
963
964 IMCC_INFO(interp)->error_code=IMCC_FATAL_EXCEPTION;
965 fprintf(stderr, "error:imcc:%s", error_str);
966 IMCC_print_inc(interp);
967 string_cstring_free(error_str);
968 Parrot_exit(interp, IMCC_FATAL_EXCEPTION);
969 }
970 IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
971 char * const error_str = string_to_cstring(interp,
972 IMCC_INFO(interp)->error_message);
973
974 IMCC_INFO(interp)->error_code=IMCC_FATALY_EXCEPTION;
975 fprintf(stderr, "error:imcc:%s", error_str);
976 IMCC_print_inc(interp);
977 string_cstring_free(error_str);
978 Parrot_exit(interp, IMCC_FATALY_EXCEPTION);
979 }
980 IMCC_END_TRY;
981
982 imc_cleanup(interp, yyscanner);
983
984 fclose(imc_yyin_get(yyscanner));
985
986 IMCC_info(interp, 1, "%ld lines compiled.\n", IMCC_INFO(interp)->line);
987 if (per_pbc)
988 PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL);
989 }
990
991 /*
992
993 =item C<int imcc_run>
994
995 Entry point of IMCC, as invoked by Parrot's main function.
996 Compile source code (if required), write bytecode file (if required)
997 and run. This function always returns 0.
998
999 =cut
1000
1001 */
1002
1003 int
1004 imcc_run(PARROT_INTERP, ARGIN(const char *sourcefile), int argc,
1005 ARGIN(char **argv))
1006 {
1007 int obj_file;
1008 yyscan_t yyscanner = IMCC_INFO(interp)->yyscanner;
1009 const char * const output_file = interp->output_file;
1010
1011 /* set the top of the stack so GC can trace it for GC-able pointers
1012 * see trace_system_areas() in src/cpu_dep.c */
1013 if (!interp->lo_var_ptr)
1014 interp->lo_var_ptr = (void *)&obj_file;
1015
1016 /* Figure out what kind of source file we have -- if we have one */
1017 if (!sourcefile || !*sourcefile)
1018 IMCC_fatal_standalone(interp, 1, "main: No source file specified.\n");
1019 else
1020 determine_input_file_type(interp, sourcefile);
1021
1022 if (pre_process_only) {
1023 do_pre_process(interp);
1024 Parrot_destroy(interp);
1025 yylex_destroy(yyscanner);
1026 IMCC_INFO(interp)->yyscanner = NULL;
1027
1028 return 0;
1029 }
1030
1031 /* Do we need to produce an output file? If so, what type? */
1032 obj_file = 0;
1033 if (output_file) {
1034 determine_output_file_type(interp, &obj_file, output_file);
1035
1036 if (STREQ(sourcefile, output_file) && !STREQ(sourcefile, "-"))
1037 IMCC_fatal_standalone(interp, 1, "main: outputfile is sourcefile\n");
1038 }
1039
1040 IMCC_INFO(interp)->write_pbc = write_pbc;
1041
1042 if (IMCC_INFO(interp)->verbose) {
1043 IMCC_info(interp, 1, "debug = 0x%x\n", IMCC_INFO(interp)->debug);
1044 IMCC_info(interp, 1, "Reading %s\n",
1045 imc_yyin_get(yyscanner) == stdin ? "stdin":sourcefile);
1046 }
1047
1048 /* If the input file is Parrot bytecode, then we simply read it
1049 into a packfile, which Parrot then loads */
1050 if (load_pbc) {
1051 PackFile * const pf = Parrot_readbc(interp, sourcefile);
1052
1053 if (!pf)
1054 IMCC_fatal_standalone(interp, 1, "main: Packfile loading failed\n");
1055 Parrot_loadbc(interp, pf);
1056 }
1057 else
1058 compile_to_bytecode(interp, sourcefile, output_file);
1059
1060 /* Produce a PBC output file, if one was requested */
1061 if (write_pbc) {
1062 if (!output_file) {
1063 IMCC_fatal_standalone(interp, 1,
1064 "main: NULL output_file when trying to write .pbc\n");
1065 }
1066 imcc_write_pbc(interp, output_file);
1067
1068 /* If necessary, load the file written above */
1069 if (run_pbc == 2 && !STREQ(output_file, "-")) {
1070 PackFile *pf;
1071
1072 IMCC_info(interp, 1, "Loading %s\n", output_file);
1073 pf = Parrot_readbc(interp, output_file);
1074 if (!pf)
1075 IMCC_fatal_standalone(interp, 1, "Packfile loading failed\n");
1076 Parrot_loadbc(interp, pf);
1077 load_pbc = 1;
1078 }
1079 }
1080
1081 /* Run the bytecode */
1082 if (run_pbc)
1083 imcc_run_pbc(interp, obj_file, output_file, argc, argv);
1084
1085 yylex_destroy(yyscanner);
1086 IMCC_INFO(interp)->yyscanner = NULL;
1087 return 0;
1088 }
1089
1090 /*
1091
1092 =back
1093
1094 =cut
1095
1096 */
1097
1098 /*
1099 * Local variables:
1100 * c-file-style: "parrot"
1101 * End:
1102 * vim: expandtab shiftwidth=4:
1103 */
parrot vm git mirror