Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: f41cf98f7b
Fetching contributors…

Cannot retrieve contributors at this time

726 lines (577 sloc) 21.895 kb
/*
*
* Intermediate Code Compiler for Parrot.
*
* Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
* Copyright (C) 2003-2010, Parrot Foundation.
*/
/*
=head1 NAME
compilers/imcc/main.c
=head1 DESCRIPTION
IMCC helpers.
=head2 Functions
=over 4
=cut
*/
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#include "imc.h"
#include "parrot/embed.h"
#include "parrot/longopt.h"
#include "parrot/imcc.h"
#include "parrot/runcore_api.h"
#include "pmc/pmc_callcontext.h"
#include "pbc.h"
#include "parser.h"
extern int yydebug;
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
static PackFile * compile_to_bytecode(PARROT_INTERP,
ARGIN(const char * const sourcefile),
ARGIN_NULLOK(const char * const output_file),
ARGIN(yyscan_t yyscanner))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(4);
static void determine_input_file_type(PARROT_INTERP,
ARGIN(const char * const sourcefile),
ARGIN(yyscan_t yyscanner))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
static void determine_output_file_type(PARROT_INTERP,
ARGIN(const char *output_file))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void do_pre_process(PARROT_INTERP, yyscan_t yyscanner)
__attribute__nonnull__(1);
static void imcc_get_optimization_description(
const PARROT_INTERP,
int opt_level,
ARGMOD(char *opt_desc))
__attribute__nonnull__(3)
FUNC_MODIFIES(*opt_desc);
static void imcc_parseflags(PARROT_INTERP,
int argc,
ARGIN(const char **argv))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
static void imcc_write_pbc(PARROT_INTERP, ARGIN(const char *output_file))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
PARROT_PURE_FUNCTION
static int is_all_hex_digits(ARGIN(const char *s))
__attribute__nonnull__(1);
#define ASSERT_ARGS_compile_to_bytecode __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(sourcefile) \
, PARROT_ASSERT_ARG(yyscanner))
#define ASSERT_ARGS_determine_input_file_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(sourcefile) \
, PARROT_ASSERT_ARG(yyscanner))
#define ASSERT_ARGS_determine_output_file_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(output_file))
#define ASSERT_ARGS_do_pre_process __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
#define ASSERT_ARGS_imcc_get_optimization_description \
__attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(opt_desc))
#define ASSERT_ARGS_imcc_parseflags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(argv))
#define ASSERT_ARGS_imcc_write_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(output_file))
#define ASSERT_ARGS_is_all_hex_digits __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(s))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
#define OPT_GC_DEBUG 128
#define OPT_DESTROY_FLAG 129
#define OPT_HELP_DEBUG 130
#define OPT_PBC_OUTPUT 131
#define OPT_RUNTIME_PREFIX 132
/*
=item C<static int is_all_hex_digits(const char *s)>
Tests all characters in a string are hexadecimal digits.
Returns 1 if true, 0 as soon as a non-hex found
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_PURE_FUNCTION
static int
is_all_hex_digits(ARGIN(const char *s))
{
ASSERT_ARGS(is_all_hex_digits)
for (; *s; s++)
if (!isxdigit(*s))
return 0;
return 1;
}
/*
=item C<static void imcc_parseflags(PARROT_INTERP, int argc, const char **argv)>
Parse flags ans set approptiate state(s)
=cut
*/
static void
imcc_parseflags(PARROT_INTERP, int argc, ARGIN(const char **argv))
{
ASSERT_ARGS(imcc_parseflags)
struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
/* default state: run pbc */
SET_STATE_RUN_PBC(interp);
while (longopt_get(interp, argc, argv, Parrot_cmd_options(), &opt) > 0) {
switch (opt.opt_id) {
case 'd':
if (opt.opt_arg && is_all_hex_digits(opt.opt_arg)) {
IMCC_INFO(interp)->debug = strtoul(opt.opt_arg, NULL, 16);
}
else {
IMCC_INFO(interp)->debug++;
}
break;
case 'w':
/* FIXME It's not best way to set warnings... */
Parrot_setwarnings(interp, PARROT_WARNINGS_ALL_FLAG);
IMCC_INFO(interp)->imcc_warn = 1;
break;
case 'G':
IMCC_INFO(interp)->gc_off = 1;
break;
case 'a':
SET_STATE_PASM_FILE(interp);
break;
case 'r':
if (STATE_RUN_PBC(interp))
SET_STATE_RUN_FROM_FILE(interp);
SET_STATE_RUN_PBC(interp);
break;
case 'c':
SET_STATE_LOAD_PBC(interp);
break;
case 'v':
IMCC_INFO(interp)->verbose++;
break;
case 'y':
yydebug = 1;
break;
case 'E':
SET_STATE_PRE_PROCESS(interp);
break;
case 'o':
UNSET_STATE_RUN_PBC(interp);
interp->output_file = opt.opt_arg;
break;
case OPT_PBC_OUTPUT:
UNSET_STATE_RUN_PBC(interp);
SET_STATE_WRITE_PBC(interp);
if (!interp->output_file)
interp->output_file = "-";
break;
case 'O':
if (!opt.opt_arg) {
IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
break;
}
if (strchr(opt.opt_arg, 'p'))
IMCC_INFO(interp)->optimizer_level |= OPT_PASM;
if (strchr(opt.opt_arg, 'c'))
IMCC_INFO(interp)->optimizer_level |= OPT_SUB;
/* currently not ok due to different register allocation */
if (strchr(opt.opt_arg, '1')) {
IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
}
if (strchr(opt.opt_arg, '2')) {
IMCC_INFO(interp)->optimizer_level |= (OPT_PRE | OPT_CFG);
}
break;
default:
/* skip already processed arguments */
break;
}
}
}
/*
=item C<static void do_pre_process(PARROT_INTERP, yyscan_t yyscanner)>
Pre-processor step. Turn parser's output codes into Parrot instructions.
=cut
*/
static void
do_pre_process(PARROT_INTERP, yyscan_t yyscanner)
{
ASSERT_ARGS(do_pre_process)
int c;
YYSTYPE val;
IMCC_push_parser_state(interp);
c = yylex(&val, yyscanner, interp); /* is reset at end of while loop */
while (c) {
switch (c) {
case EMIT: printf(".emit\n"); break;
case EOM: printf(".eom\n"); break;
case LOCAL: printf(".local "); break;
case ARG: printf(".set_arg "); break;
case SUB: printf(".sub "); break;
case ESUB: printf(".end"); break;
case RESULT: printf(".result "); break;
case RETURN: printf(".return "); break;
case NAMESPACE: printf(".namespace "); break;
case CONST: printf(".const "); break;
case PARAM: printf(".param "); break;
case MACRO: printf(".macro "); break;
case GOTO: printf("goto ");break;
case IF: printf("if ");break;
case UNLESS: printf("unless ");break;
case INTV: printf("int ");break;
case FLOATV: printf("float ");break;
case STRINGV: printf("string ");break;
case PMCV: printf("pmc ");break;
case SHIFT_LEFT: printf(" << ");break;
case SHIFT_RIGHT: printf(" >> ");break;
case SHIFT_RIGHT_U: printf(" >>> ");break;
case LOG_AND: printf(" && ");break;
case LOG_OR: printf(" || ");break;
case LOG_XOR: printf(" ~~ ");break;
case RELOP_LT: printf(" < ");break;
case RELOP_LTE: printf(" <= ");break;
case RELOP_GT: printf(" > ");break;
case RELOP_GTE: printf(" >= ");break;
case RELOP_EQ: printf(" == ");break;
case RELOP_NE: printf(" != ");break;
case POW: printf(" ** ");break;
case COMMA: printf(", ");break;
case LABEL: printf("%s:\t", val.s); break;
case PCC_BEGIN: printf(".begin_call "); break;
case PCC_END: printf(".end_call"); break;
case PCC_SUB: printf(".pccsub "); break;
case PCC_CALL: printf(".call "); break;
case PCC_BEGIN_RETURN: printf(".begin_return"); break;
case PCC_END_RETURN: printf(".end_return"); break;
case PCC_BEGIN_YIELD: printf(".begin_yield"); break;
case PCC_END_YIELD: printf(".end_yield"); break;
case FILECOMMENT: printf("setfile \"%s\"\n", val.s); break;
case LINECOMMENT: printf("setline %d\n", val.t); break;
case PLUS_ASSIGN: printf("+= ");break;
case MINUS_ASSIGN: printf("-= ");break;
case MUL_ASSIGN: printf("*= ");break;
case DIV_ASSIGN: printf("/= ");break;
case MOD_ASSIGN: printf("%%= ");break;
case FDIV_ASSIGN: printf("//= ");break;
case BAND_ASSIGN: printf("&= ");break;
case BOR_ASSIGN: printf("|= ");break;
case BXOR_ASSIGN: printf("~= ");break;
case SHR_ASSIGN: printf(">>= ");break;
case SHL_ASSIGN: printf("<<= ");break;
case SHR_U_ASSIGN: printf(">>>= ");break;
case CONCAT_ASSIGN: printf(".= ");break;
case MAIN: printf(":main");break;
case LOAD: printf(":load");break;
case INIT: printf(":init");break;
case IMMEDIATE: printf(":immediate");break;
case POSTCOMP: printf(":postcomp");break;
case ANON: printf(":anon");break;
case OUTER: printf(":outer");break;
case NEED_LEX: printf(":lex");break;
case METHOD: printf(":method");break;
case UNIQUE_REG: printf(":unique_reg");break;
case ADV_FLAT: printf(":flat");break;
case ADV_SLURPY: printf(":slurpy");break;
case ADV_OPTIONAL: printf(":optional");break;
case ADV_OPT_FLAG: printf(":opt_flag");break;
case ADV_NAMED: printf(":named");break;
case ADV_ARROW: printf("=>");break;
default:
if (c < 255)
printf("%c", c);
else
printf("%s ", val.s);
break;
}
c = yylex(&val, yyscanner, interp);
}
printf("\n");
fflush(stdout);
return;
}
/*
=item C<static void imcc_get_optimization_description(const PARROT_INTERP, int
opt_level, char *opt_desc)>
Create list (opt_desc[]) describing optimisation flags.
=cut
*/
static void
imcc_get_optimization_description(const PARROT_INTERP, int opt_level, ARGMOD(char *opt_desc))
{
ASSERT_ARGS(imcc_get_optimization_description)
int i = 0;
if (opt_level & (OPT_PRE | OPT_CFG))
opt_desc[i++] = '2';
else
if (opt_level & OPT_PRE)
opt_desc[i++] = '1';
if (opt_level & OPT_PASM)
opt_desc[i++] = 'p';
if (opt_level & OPT_SUB)
opt_desc[i++] = 'c';
opt_desc[i] = '\0';
return;
}
/*
=item C<void imcc_run_pbc(PARROT_INTERP, const char *output_file, int argc,
const char **argv)>
Write out or run Parrot bytecode.
=cut
*/
void
imcc_run_pbc(PARROT_INTERP, ARGIN_NULLOK(const char *output_file),
int argc, ARGIN(const char **argv))
{
/* ASSERT_ARGS(imcc_run_pbc) */
IMCC_info(interp, 1, "Running...\n");
/* runs :init functions */
PackFile_fixup_subs(interp, PBC_IMMEDIATE, NULL);
PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL);
PackFile_fixup_subs(interp, PBC_MAIN, NULL);
Parrot_runcode(interp, argc, argv);
}
/*
=item C<static void imcc_write_pbc(PARROT_INTERP, const char *output_file)>
Output packed bytecode file.
=cut
*/
static void
imcc_write_pbc(PARROT_INTERP, ARGIN(const char *output_file))
{
ASSERT_ARGS(imcc_write_pbc)
size_t size;
opcode_t *packed;
FILE *fp;
IMCC_info(interp, 1, "Writing %s\n", output_file);
size = PackFile_pack_size(interp, interp->code->base.pf) *
sizeof (opcode_t);
IMCC_info(interp, 1, "packed code %d bytes\n", size);
packed = (opcode_t*) mem_sys_allocate(size);
PackFile_pack(interp, interp->code->base.pf, packed);
if (STREQ(output_file, "-"))
fp = stdout;
else if ((fp = fopen(output_file, "wb")) == NULL)
IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
"Couldn't open %s\n", output_file);
if ((1 != fwrite(packed, size, 1, fp)))
IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
"Couldn't write %s\n", output_file);
fclose(fp);
IMCC_info(interp, 1, "%s written.\n", output_file);
mem_sys_free(packed);
}
/*
=item C<static void determine_input_file_type(PARROT_INTERP, const char * const
sourcefile, yyscan_t yyscanner)>
Read in the source and determine whether it's Parrot bytecode or PASM
=cut
*/
static void
determine_input_file_type(PARROT_INTERP, ARGIN(const char * const sourcefile),
ARGIN(yyscan_t yyscanner))
{
ASSERT_ARGS(determine_input_file_type)
/* Read in the source and check the file extension for the input type;
a file extension .pbc means it's parrot bytecode;
a file extension .pasm means it's parrot assembly (PASM);
otherwise, it's assumed to be PIR.
*/
if (STREQ(sourcefile, "-")) {
imc_yyin_set(stdin, yyscanner);
}
else {
const char * const ext = strrchr(sourcefile, '.');
if (ext && (STREQ(ext, ".pbc"))) { /* a PBC file */
SET_STATE_LOAD_PBC(interp);
UNSET_STATE_WRITE_PBC(interp);
}
else if (!STATE_LOAD_PBC(interp)) {
if (!(imc_yyin_set(fopen(sourcefile, "r"), yyscanner))) {
IMCC_fatal_standalone(interp, EXCEPTION_EXTERNAL_ERROR,
"Error reading source file %s.\n",
sourcefile);
}
if (ext && STREQ(ext, ".pasm"))
SET_STATE_PASM_FILE(interp);
}
}
}
/*
=item C<static void determine_output_file_type(PARROT_INTERP, const char
*output_file)>
Decide what kind of file we are to output.
=cut
*/
static void
determine_output_file_type(PARROT_INTERP, ARGIN(const char *output_file))
{
ASSERT_ARGS(determine_output_file_type)
const char * const ext = strrchr(output_file, '.');
if (ext) {
if (STREQ(ext, ".pbc"))
SET_STATE_WRITE_PBC(interp);
}
}
/*
=item C<static PackFile * compile_to_bytecode(PARROT_INTERP, const char * const
sourcefile, const char * const output_file, yyscan_t yyscanner)>
Compile source code into bytecode (or die trying).
=cut
*/
static PackFile *
compile_to_bytecode(PARROT_INTERP,
ARGIN(const char * const sourcefile),
ARGIN_NULLOK(const char * const output_file),
ARGIN(yyscan_t yyscanner))
{
ASSERT_ARGS(compile_to_bytecode)
PackFile *pf;
const int per_pbc = STATE_WRITE_PBC(interp) || STATE_RUN_PBC(interp);
const int opt_level = IMCC_INFO(interp)->optimizer_level;
/* Shouldn't be more than five, but five extra is cheap */
char opt_desc[10];
imcc_get_optimization_description(interp, opt_level, opt_desc);
IMCC_info(interp, 1, "using optimization '-O%s' (%x) \n",
opt_desc, opt_level);
pf = PackFile_new(interp, 0);
Parrot_pbc_load(interp, pf);
IMCC_push_parser_state(interp);
IMCC_INFO(interp)->state->file = mem_sys_strdup(sourcefile);
emit_open(interp, per_pbc, per_pbc ? NULL : output_file);
IMCC_info(interp, 1, "Starting parse...\n");
IMCC_INFO(interp)->state->pasm_file = STATE_PASM_FILE(interp) ? 1 : 0;
imcc_run_compilation(interp, yyscanner);
if (IMCC_INFO(interp)->error_code) {
char * const error_str = Parrot_str_to_cstring(interp,
IMCC_INFO(interp)->error_message);
IMCC_INFO(interp)->error_code=IMCC_FATAL_EXCEPTION;
fprintf(stderr, "error:imcc:%s", error_str);
IMCC_print_inc(interp);
Parrot_str_free_cstring(error_str);
Parrot_exit(interp, IMCC_FATAL_EXCEPTION);
}
imc_cleanup(interp, yyscanner);
fclose(imc_yyin_get(yyscanner));
IMCC_info(interp, 1, "%ld lines compiled.\n", IMCC_INFO(interp)->line);
if (per_pbc && !IMCC_INFO(interp)->write_pbc)
PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL);
return pf;
}
int
imcc_run_api(ARGMOD(PMC * interp_pmc), ARGIN(const char *sourcefile), int argc,
ARGIN(const char **argv), ARGOUT(PMC **pbcpmc))
{
Interp * interp = VTABLE_get_pointer(NULL, interp_pmc);
return imcc_run(interp, sourcefile, argc, argv, pbcpmc);
}
/*
=item C<int imcc_run(PARROT_INTERP, const char *sourcefile, int argc, const char
**argv, PMC **pbcpmc)>
Entry point of IMCC, as invoked by Parrot's main function.
Compile source code (if required), write bytecode file (if required)
and run. This function always returns 0.
=cut
*/
int
imcc_run(PARROT_INTERP, ARGIN(const char *sourcefile), int argc,
ARGIN(const char **argv), ARGOUT(PMC **pbcpmc))
{
yyscan_t yyscanner;
const char * const output_file = interp->output_file;
PackFile * pf_raw = NULL;
*pbcpmc = PMCNULL;
imcc_parseflags(interp, argc, argv);
/* PMCs in IMCC_INFO won't get marked */
Parrot_block_GC_mark(interp);
Parrot_block_GC_sweep(interp);
yylex_init_extra(interp, &yyscanner);
/* Figure out what kind of source file we have -- if we have one */
if (!sourcefile || !*sourcefile)
IMCC_fatal_standalone(interp, 1, "main: No source file specified.\n");
else
determine_input_file_type(interp, sourcefile, yyscanner);
if (STATE_PRE_PROCESS(interp)) {
do_pre_process(interp, yyscanner);
Parrot_destroy(interp);
yylex_destroy(yyscanner);
return 0;
}
/* Do we need to produce an output file? If so, what type? */
if (output_file) {
determine_output_file_type(interp, output_file);
if (STREQ(sourcefile, output_file) && !STREQ(sourcefile, "-"))
IMCC_fatal_standalone(interp, 1, "main: outputfile is sourcefile\n");
}
IMCC_INFO(interp)->write_pbc = STATE_WRITE_PBC(interp) ? 1 : 0;
if (IMCC_INFO(interp)->verbose) {
IMCC_info(interp, 1, "debug = 0x%x\n", IMCC_INFO(interp)->debug);
IMCC_info(interp, 1, "Reading %s\n",
imc_yyin_get(yyscanner) == stdin ? "stdin":sourcefile);
}
/* If the input file is Parrot bytecode, then we simply read it
into a packfile, which Parrot then loads */
if (STATE_LOAD_PBC(interp)) {
pf_raw = Parrot_pbc_read(interp, sourcefile, 0);
if (!pf_raw)
IMCC_fatal_standalone(interp, 1, "main: Packfile loading failed\n");
Parrot_pbc_load(interp, pf_raw);
}
else
pf_raw = compile_to_bytecode(interp, sourcefile, output_file, yyscanner);
/* Produce a PBC output file, if one was requested */
if (STATE_WRITE_PBC(interp)) {
if (!output_file) {
IMCC_fatal_standalone(interp, 1,
"main: NULL output_file when trying to write .pbc\n");
}
imcc_write_pbc(interp, output_file);
/* If necessary, load the file written above */
if (STATE_RUN_FROM_FILE(interp) && !STREQ(output_file, "-")) {
IMCC_info(interp, 1, "Loading %s\n", output_file);
pf_raw = Parrot_pbc_read(interp, output_file, 0);
if (!pf_raw)
IMCC_fatal_standalone(interp, 1, "Packfile loading failed\n");
Parrot_pbc_load(interp, pf_raw);
SET_STATE_LOAD_PBC(interp);
}
}
/* tear down the compilation context */
if (IMCC_INFO(interp)->imcc_warn)
PARROT_WARNINGS_on(interp, PARROT_WARNINGS_ALL_FLAG);
else
PARROT_WARNINGS_off(interp, PARROT_WARNINGS_ALL_FLAG);
if (!IMCC_INFO(interp)->gc_off) {
Parrot_unblock_GC_mark(interp);
Parrot_unblock_GC_sweep(interp);
}
yylex_destroy(yyscanner);
if (pf_raw) {
PMC * const _pbcpmc = Parrot_pmc_new(interp, enum_class_Packfile);
VTABLE_set_pointer(interp, _pbcpmc, pf_raw);
*pbcpmc = _pbcpmc;
}
/* should the bytecode be run */
if (STATE_RUN_PBC(interp))
return 1;
else
return 0;
}
/*
=back
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
Jump to Line
Something went wrong with that request. Please try again.