cvsuser 02/09/22 10:38:47
Modified: languages/imcc imcc.l imcc.y
Log:
Large patch from Leo, see ChangeLog.
Revision Changes Path
1.12 +61 -53 parrot/languages/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.l,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- imcc.l 8 Sep 2002 03:51:23 -0000 1.11
+++ imcc.l 22 Sep 2002 17:38:47 -0000 1.12
@@ -16,8 +16,10 @@
#include "imc.h"
#include "imcparser.h"
+#define YY_NO_UNPUT
extern long line;
-extern int expect_eol;
+extern int expect_pasm;
+int state;
int yyerror(char *);
%}
@@ -31,50 +33,47 @@
STRINGCONSTANT \"(\\.|[^"\n]*)*["\n]
CHARCONSTANT \'[^'\n]*\'
RANKSPEC \[[,]*\]
+EOL \r?\n
-%x emit2
-%s expecteol
+%x emit
%%
/* for emacs: ' */
- if (expect_eol)
- BEGIN(expecteol);
-
-^".emit\n"(.|\n)*".eom\n" {
- char * s = strstr(yytext, ".eom");
- if(s) {
- s[0] = '\n';
- s[1] = 0;
- }
- yylval.s = str_dup(&yytext[5]);
- return EMIT;
- }
-
-^".emit2"\n {
- BEGIN(emit2);
+ if (expect_pasm == 1) {
+ expect_pasm = 2;
+ BEGIN(emit);
}
-<emit2>^".eom"\n {
+<INITIAL,emit>{EOL} {
+ if (expect_pasm == 2)
BEGIN(INITIAL);
+ expect_pasm = 0;
+ line++;
+ return '\n';
}
-<emit2>.|\n ;
-
-<expecteol>[\n] {
+<INITIAL,emit>#.*{EOL} {
+ if (expect_pasm == 2)
BEGIN(INITIAL);
- expect_eol = 0;
+ expect_pasm = 0;
line++;
return '\n';
}
-<expecteol>#.*[\n] {
+
+^".emit"\n {
+ BEGIN(emit);
+ return(EMIT);
+ }
+
+<emit>^".eom"\n {
BEGIN(INITIAL);
- expect_eol = 0;
- line++;
- return '\n';
+ return EOM;
}
-[\n] line++;
-#.*\n line++;
+<emit,INITIAL>[ISNP]{DIGIT}{DIGIT}? {
+ yylval.s = str_dup(yytext);
+ return REG;
+ }
".sym" return(SYM);
".arg" return(ARG);
@@ -118,59 +117,75 @@
"==" return(RELOP_EQ);
"!=" return(RELOP_NE);
"**" return(POW);
-"," return(COMMA);
-{LETTER}{LETTERDIGIT}*":" {
+<emit,INITIAL>"," return(COMMA);
+
+<emit,INITIAL>{LETTER}{LETTERDIGIT}*":" {
yytext[yyleng-1] = 0; /* trim last ':' */
yylval.s = str_dup(yytext);
return(LABEL);
}
-{DOT}?{LETTER}{LETTERDIGIT}* {
+<emit>{DOT}{LETTER}{LETTERDIGIT}* { /* XXX */
yylval.s = str_dup(yytext);
- return(IDENTIFIER);
+ return(MACRO);
+ }
+<INITIAL>{DOT}?{LETTER}{LETTERDIGIT}* {
+ SymReg *r = get_sym(yytext);
+ if (r && r->type & VTIDENTIFIER) {
+ yylval.sr = r;
+ return VAR;
+ }
+ yylval.s = str_dup(yytext);
+ return(is_op(yylval.s) ? PARROT_OP : IDENTIFIER);
+ }
+<emit,INITIAL>{LETTER}{LETTERDIGIT}* {
+ SymReg *r = get_sym(yytext);
+ if (r && r->type & VTIDENTIFIER) {
+ yylval.sr = r;
+ return VAR;
+ }
+ yylval.s = str_dup(yytext);
+ return(is_op(yylval.s) ? PARROT_OP : IDENTIFIER);
}
-{SIGN}?{DIGIT}+"."{DIGIT}+ {
+<emit,INITIAL>{SIGN}?{DIGIT}+"."{DIGIT}+ {
yylval.s = str_dup(yytext);
return(FLOATC);
}
-{SIGN}?{DIGIT}+ {
+<emit,INITIAL>{SIGN}?{DIGIT}+ {
yylval.s = str_dup(yytext);
return(INTC);
}
-{STRINGCONSTANT} {
- yylval.s = str_dup(yytext);
+<emit,INITIAL>{STRINGCONSTANT} {
+ yylval.s = str_dup(yytext); /* XXX delete quotes, -> emit, pbc */
return(STRINGC);
}
-\$I[0-9]+ {
+<emit,INITIAL>\$I[0-9]+ {
yylval.s = str_dup(yytext);
return(IREG);
}
-\$N[0-9]+ {
+<emit,INITIAL>\$N[0-9]+ {
yylval.s = str_dup(yytext);
return(NREG);
}
-\$S[0-9]+ {
+<emit,INITIAL>\$S[0-9]+ {
yylval.s = str_dup(yytext);
return(SREG);
}
-\$P[0-9]+ {
+<emit,INITIAL>\$P[0-9]+ {
yylval.s = str_dup(yytext);
return(PREG);
}
-[\t\f\r ]+ ;
-. {
-#if 0
- fprintf(stderr, "token[%s]\n", yytext);
-#endif
+<emit,INITIAL>[\t\f\r ]+ ;
+<emit,INITIAL>. {
return yytext[0];
}
@@ -187,11 +202,4 @@
yy_delete_buffer(YY_CURRENT_BUFFER);
return 1;
}
-
-#if 0
-char * str_dup(const char * buf) {
- char * s = malloc(strlen(buf)+1);
- return s;
-}
-#endif
1.22 +685 -513 parrot/languages/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.y,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- imcc.y 6 Sep 2002 07:13:52 -0000 1.21
+++ imcc.y 22 Sep 2002 17:38:47 -0000 1.22
@@ -13,16 +13,20 @@
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
+
+#define _PARSER
+#define MAIN
#include "imc.h"
-#include "anyop.h"
+#include "parrot/embed.h"
+#include "pbc.h"
#define YYDEBUG 1
+/* #define OPTEST */
int yyerror(char *);
int yylex();
extern char yytext[];
-long line;
-int expect_eol;
+int expect_pasm;
/*
* Choosing instructions for Parrot is pretty easy since
@@ -30,7 +34,11 @@
*/
-static SymReg *regs[PARROT_MAX_ARGS];
+static SymReg *regs[IMCC_MAX_REGS];
+static int nargs = 0;
+static SymReg *keys[IMCC_MAX_REGS];
+static int nkeys = 0;
+
static SymReg ** RR(int n, ...)
{
va_list ap;
@@ -40,502 +48,412 @@
while (n--) {
regs[i++] = va_arg(ap, SymReg *);
}
- while (i < PARROT_MAX_ARGS)
+ while (i < IMCC_MAX_REGS)
regs[i++] = 0;
return regs;
}
-/* intermediate macros for registers */
-#define R2(r0,r1) RR(2,r0,r1)
-#define R regs[0],regs[1],regs[2],regs[3]
-
-SymReg * iMOVE(SymReg *r0, SymReg*r1) {
- int flags = IF_unary;
- R2(r0, r1);
- if (r0->set == 'P' && r1->set != 'P') {
- /* r0 needs read access because set Px, Ax calls Px's set
- * method, instead of just clobbering it. */
- flags = IF_r0_write|IF_r0_read|IF_r1_read;
- }
- emitb(mk_instruction("set %s, %s", R, flags));
- return r0;
-}
-
-SymReg * iNOT(SymReg *r0, SymReg*r1) {
- emitb(mk_instruction("not %s, %s", r0, r1, NULL, NULL, IF_unary));
- return r0;
-}
-
-SymReg * iNEG(SymReg *r0, SymReg*r1) {
- if (r0->set != 'S' || r0->set == r1->set) {
- emitb(mk_instruction("neg %s, %s", r0, r1, NULL, NULL, IF_unary));
- }
- else {
- fprintf(stderr, "line %ld: Syntax error, neg arguments must be int, float,
or PMC\n",
- line);
- exit(EX_DATAERR);
- }
- return r0;
-}
-
-SymReg * iINC(SymReg *r0) {
- emitb(mk_instruction("inc %s", r0, NULL, NULL, NULL, IF_inplace));
- return r0;
-}
-
-SymReg * iDEC(SymReg *r0) {
- emitb(mk_instruction("dec %s", r0, NULL, NULL, NULL, IF_inplace));
- return r0;
-}
-
-SymReg * iADD(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("add %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iSUB(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("sub %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iMUL(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("mul %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iPOW(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("pow %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-SymReg * iDIV(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("div %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iMOD(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("mod %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iSHL(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("shl %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iSHR(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("shr %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
-
-SymReg * iXOR(SymReg *r0, SymReg*r1, SymReg *r2) {
- if ((r0->set == 'I' && r1->set == 'I' && r2->set == 'I')
- || (r0->set == 'P' && r1->set == 'P' && r2->set == 'P')) {
- emitb(mk_instruction("xor %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- }
- else {
- fprintf(stderr, "line %ld: Syntax error, xor arguments must be int or
PMC\n",
- line);
- exit(EX_DATAERR);
- }
- return r0;
-}
-
-SymReg * iBAND(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("band %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
+/* macros for registers */
+#define R0() RR(nargs=0)
+#define R1(r0) RR(nargs=1,r0)
+#define R2(r0,r1) RR(nargs=2,r0,r1)
+#define R3(r0,r1,r2) RR(nargs=3,r0,r1,r2)
+#define R4(r0,r1,r2,r3) RR(nargs=4,r0,r1,r2,r3)
-SymReg * iBOR(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("bor %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
-}
+Instruction * iANY(char * name, char *fmt, SymReg **r, int emit);
-SymReg * iBXOR(SymReg *r0, SymReg*r1, SymReg *r2) {
- emitb(mk_instruction("bxor %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- return r0;
+/*
+ * MK_I: build and emitb instruction by iANY
+ *
+ * fmt may contain:
+ * op %s, %s # comment
+ * or just
+ * op
+ *
+ */
+static Instruction * MK_I(char * fmt, SymReg ** r) {
+ char opname[64];
+ char *p, *q;
+ for (p = opname, q = fmt; *q && *q != ' '; )
+ *p++ = *q++;
+ *p = 0;
+ if (!*q)
+ fmt = 0;
+ else
+ fmt = ++q;
+#if OPDEBUG
+ fprintf(stderr, "op '%s' format '%s' (%d)\n", opname, fmt?:"",nargs);
+#endif
+ return iANY(opname, fmt, r, 1);
}
-SymReg * iCONCAT(SymReg *r0, SymReg*r1, SymReg *r2) {
- if((r0->set == 'S' && r1->set == 'S' && r2->set == 'S')
- || (r0->set == 'P' && r1->set == 'P' && r2->set == 'P')) {
- emitb(mk_instruction("concat %s, %s, %s", r0, r1, r2, NULL, IF_binary));
- }
- else {
- fprintf(stderr, "line %ld: Syntax error, concat arguments must be all
strings or all PMC's\n",
- line);
- exit(EX_DATAERR);
- }
- return r0;
-}
+/*
+ * special instructions
+ *
+ * labels and such
+ */
-SymReg * iCALL(SymReg * r0) {
- emitb(mk_instruction("bsr %s", r0, NULL, NULL, NULL, IF_r0_read));
- return r0;
-}
-SymReg * iBRANCH(SymReg * r0) {
- Instruction * i = emitb(mk_instruction("branch %s", r0, NULL, NULL, NULL,
IF_r0_branch | IF_goto));
- i->type = ITBRANCH;
- return r0;
-}
-SymReg * iLABEL(SymReg * r0) {
- Instruction *i = emitb(mk_instruction("%s:", r0, NULL, NULL, NULL,
- 0)); /* IF_r0_read ? */
+static Instruction * iLABEL(SymReg * r0) {
+ Instruction *i = emitb(_mk_instruction("","%s:", R1(r0), 0));
i->type = ITLABEL;
- return r0;
-}
-
-SymReg * iARG(SymReg * r0) {
- emitb(mk_instruction("save %s", r0, NULL, NULL, NULL, IF_r0_read));
- return r0;
-}
-
-SymReg * iPUSH(SymReg * r0) {
- emitb(mk_instruction("save %s", r0, NULL, NULL, NULL, IF_r0_read));
- return r0;
+ return i;
}
-SymReg * iPOP(SymReg * r0) {
- emitb(mk_instruction("restore %s", r0, NULL, NULL, NULL, IF_r0_write));
- return r0;
-}
-
-SymReg * iRESULT(SymReg * r0) {
- return iPOP(r0);
-}
-
-SymReg * iRETURN(SymReg * r0) {
- return iPUSH(r0);
-}
-
-SymReg * iSAVEALL() {
- emitb(mk_instruction("saveall", NULL, NULL, NULL, NULL, 0));
- return 0;
-}
-SymReg * iRESTOREALL() {
- emitb(mk_instruction("restoreall", NULL, NULL, NULL, NULL, 0));
- return 0;
-}
-
-SymReg * iPRINT(SymReg * r0) {
- emitb(mk_instruction("print %s", r0, NULL, NULL, NULL, IF_r0_read));
- return r0;
-}
-
-SymReg * iSUBROUTINE(SymReg * r0) {
- emitb(mk_instruction("%s:", r0, NULL, NULL, NULL, IF_r0_read)); /* IF_r0_read?
*/
- return r0;
+static Instruction * iSUBROUTINE(SymReg * r0) {
+ function = r0->name;
+ return iLABEL(r0); /* XXX mark label global */
}
-SymReg * iRET() {
- emitb(mk_instruction("ret", NULL, NULL, NULL, NULL, 0));
- return 0;
-}
-SymReg * iINDEXFETCH(SymReg * r0, SymReg * r1, SymReg * r2) {
+/*
+ * substr or X = P[key]
+ */
+static Instruction * iINDEXFETCH(SymReg * r0, SymReg * r1, SymReg * r2) {
if(r0->set == 'S' && r1->set == 'S' && r2->set == 'I') {
- emitb(mk_instruction("substr %s, %s, %s, 1", r0, r1, r2, NULL, IF_binary));
- }
- else if (r1->set == 'P') {
- emitb(mk_instruction("set %s, %s[%s]", r0, r1, r2, NULL, IF_binary));
- r1->score = 1000;
- }
- else {
- fprintf(stderr, "FIXME: Internal error, unsupported indexed fetch
operation\n");
- exit(EX_SOFTWARE);
+ return MK_I("substr %s, %s, %s, 1", R3(r0, r1, r2));
}
- return r0;
+ return MK_I("set %s, %s[%s]", R3(r0,r1,r2));
}
-SymReg * iINDEXSET(SymReg * r0, SymReg * r1, SymReg * r2) {
- if(r0->set == 'S' && r1->set == 'I' && r2->set == 'S') {
- /* Temporaries assigned by IMCC are of form (T.n)
- SymReg * temp = mk_symreg("(S.0)", 'S');
+/*
+ * substr or P[key] = X
*/
- emitb(mk_instruction("substr %s, %s, 1, %s", r0, r1, r2, NULL, IF_binary));
+
+static Instruction * iINDEXSET(SymReg * r0, SymReg * r1, SymReg * r2) {
+ if(r0->set == 'S' && r1->set == 'I' && r2->set == 'S') {
+ MK_I("substr %s, %s, 1, %s", R3(r0, r1, r2));
}
else if (r0->set == 'P') {
- /* XXX: SEAN: is "read" right for setting an array? */
- emitb(mk_instruction("set %s[%s], %s", r0, r1, r2, NULL,
- IF_r0_write | IF_r1_read | IF_r2_read));
- r0->score = 1000;
+ MK_I("set %s[%s], %s", R3(r0,r1,r2));
}
else {
- fprintf(stderr, "FIXME: Internal error, unsupported indexed set
operation\n");
- exit(EX_SOFTWARE);
+ fataly(EX_SOFTWARE, "iINDEXSET", line,"unsupported indexed set op\n");
}
- return r0;
-}
-
-SymReg * iIF(int relop, SymReg * r0, SymReg * r1, SymReg * r2) {
- Instruction * i;
- char op[256];
- relop_to_op(relop, op);
- strcat(op, " %s, %s, %s");
- i = emitb(mk_instruction(op, r0, r1, r2, NULL, IF_r0_read | IF_r1_read |
IF_r2_branch));
- i->type = ITBRANCH;
return 0;
}
-SymReg * iIF1(char *f, SymReg * r0, SymReg * dest)
+/* return the index of a PMC class */
+static int get_pmc_num(char *pmc_type)
{
- Instruction * i;
- char op[256];
- sprintf(op, "%s %%s, %%s", f);
- i = emitb(mk_instruction(op, r0, dest, 0, NULL, IF_r0_read | IF_r1_branch));
- i->type = ITBRANCH;
- return 0;
-}
-
-SymReg * iNEW(SymReg * r0, char * type) {
- char op[256];
- strcpy(op, "new %s, .");
- strcat(op, type);
- emitb(mk_instruction(op, r0, NULL, NULL, NULL, IF_r0_write ));
- free(type);
- return r0;
+ STRING * s = string_make(interpreter, pmc_type,
+ (UINTVAL) strlen(pmc_type), NULL, 0, NULL);
+ PMC * key = key_new_string(interpreter, s);
+ return Parrot_base_classname_hash->vtable->get_integer_keyed(
+ interpreter, Parrot_base_classname_hash, key);
}
-SymReg * iDEFINED(SymReg * r0, SymReg * r1) {
- if (r0->set == 'I' && r1->set == 'P') {
- emitb(mk_instruction("defined %s, %s", r0, r1, NULL, NULL,
- IF_r0_write | IF_r1_read ));
- }
- else {
- fprintf(stderr, "line %ld: Syntax error, defined: arguments must be int,
PMC\n",
- line);
- exit(EX_DATAERR);
- }
- return r0;
+/* only .PmcType */
+static SymReg * macro(char *name)
+{
+ SymReg * r;
+ char buf[16];
+ int type = get_pmc_num(name);
+ sprintf(buf, "%d", type);
+ r = mk_const(str_dup(buf), 'I');
+ return r;
}
-
-/* XXX -lt
- the address may be the target of a jump
- must we deal with this - think try/CATCH
+/*
+ * new P, .SomeThing
*/
-
-SymReg * iSET_ADDR(SymReg * r0, SymReg * r1) {
- if (r0->set == 'I') {
- emitb(mk_instruction("set_addr %s, %s", r0, r1, NULL, NULL,
- IF_r0_write));
- }
- else {
- fprintf(stderr, "line %ld: Syntax error, set_addr destination must be int
register\n", line);
- exit(EX_DATAERR);
- }
- return r0;
+static Instruction * iNEW(SymReg * r0, char * type) {
+ char fmt[256];
+ SymReg *pmc = macro(type);
+ /* XXX check, if type exists, but aove keyed search
+ * gives 0 for non existing PMCs */
+ sprintf(fmt, "new %%s, %d\t # .%s", atoi(pmc->name), type);
+ r0->usage = U_NEW;
+ if (!strcmp(type, "PerlArray") || !strcmp(type, "PerlHash"))
+ r0->usage |= U_KEYED;
+ MK_I(fmt, R2(r0, pmc)); /* new_p_ic */
+ free(type);
+ return 0;
}
-SymReg * iSET_GLOBAL(SymReg * r0, SymReg * r1) {
- if (r0->set == 'S' && r1->set == 'P') {
- emitb(mk_instruction("store_global %s, %s", r0, r1,
- NULL, NULL, IF_r0_read | IF_r1_read));
- }
- else {
- fprintf(stderr, "line %ld: store_global arguments must be PMC, string\n",
- line);
- exit(EX_DATAERR);
- }
- return r0;
-}
+/* TODO get rid of nargs */
+void
+op_fullname(char * dest, const char * name, SymReg * args[], int nargs) {
+ int i;
-SymReg * iGET_GLOBAL(SymReg * r0, SymReg * r1) {
- if (r0->set == 'P' && r1->set == 'S') {
- emitb(mk_instruction("find_global %s, %s", r0, r1,
- NULL, NULL, IF_r0_write | IF_r1_read));
- }
- else {
- fprintf(stderr, "line %ld: find_global arguments must be PMC, string\n",
- line);
- exit(EX_DATAERR);
+ strcpy(dest, name);
+ dest += strlen(name);
+ for (i = 0; i < nargs && args[i]; i++) {
+ *dest++ = '_';
+ if (args[i]->type == VTADDRESS) {
+ *dest++ = 'i';
+ *dest++ = 'c';
+ continue;
}
- return r0;
+ /* if one ever wants num keys, they go with 'S' */
+ if (args[i]->type & VTKEY) {
+ *dest++ = 'k';
+ if (args[i]->set == 'S' || args[i]->set == 'N' ||
+ args[i]->set == 'K') {
+ *dest++ = 'c';
+ continue;
}
-
-SymReg * iCLONE(SymReg * r0, SymReg * r1) {
- if (r0->set == r1->set && (r0->set == 'S' || r0->set == 'P')) {
- emitb(mk_instruction("clone %s, %s", r0, r1,
- NULL, NULL, IF_r0_write | IF_r1_read));
}
- else {
- fprintf(stderr, "line %ld: clone arguments must be PMCs or strings\n",
- line);
- exit(EX_DATAERR);
+ *dest++ = tolower(args[i]->set);
+ if (args[i]->type & VTCONST)
+ *dest++ = 'c';
}
- return r0;
+ *dest = '\0';
}
-
-SymReg * iEMIT(char * assembly) {
- emitb(mk_instruction(assembly, NULL, NULL, NULL, NULL, 0));
- free(assembly);
- return 0;
+#if 0
+#define OP_HASH_SIZE 1511
+typedef struct hop {
+ op_info_t * info;
+ struct hop *next;
+} HOP;
+static HOP **hop;
+static void hop_init();
+
+static void store_op(op_info_t *info, int full) {
+ HOP *p = malloc(sizeof(HOP));
+ int index = hash_str(full ? info->full_name : info->name) % OP_HASH_SIZE;
+ p->info = info;
+ p->next = hop[index];
+ hop[index] = p;
+}
+int get_op(const char * name, int full) {
+ HOP * p;
+ int index = hash_str(name) % OP_HASH_SIZE;
+ if (!hop) {
+ hop = calloc(OP_HASH_SIZE, sizeof(HOP*));
+ hop_init();
+ }
+ for(p = hop[index]; p; p = p->next) {
+ if(!strcmp(name, full ? p->info->full_name : p->info->name))
+ return p->info - interpreter->op_info_table;
}
-
-SymReg * iEND() {
- emitb(mk_instruction("end", NULL, NULL, NULL, NULL, 0));
- return 0;
+ return -1;
}
-
-int nargs = 0;
-SymReg * args[16] = { NULL };
-
-static void
-op_fullname(char * dest, const char * name, SymReg * args[], int nargs) {
+static void hop_init() {
int i;
- int key_index = -1;
-
- strcpy(dest, name);
- dest += strlen(name);
- if (strcmp(name, "set") == 0) {
- if (args[0]->set == 'P' && args[1]->set != 'P') {
- key_index = 1;
+ op_info_t * info = interpreter->op_info_table;
+ /* store full names */
+ for (i = 0; i < interpreter->op_count; i++)
+ store_op(info + i, 1);
+ /* plus one short name */
+ for (i = 0; i < interpreter->op_count; i++)
+ if (get_op(info[i].name, 0) == -1)
+ store_op(info + i, 0);
}
- else if (args[1]->set == 'P' && args[2]->set != 'P') {
- key_index = 2;
- }
- else {
- fprintf(stderr, "Can't figure out keyed op!\n");
- exit(EX_SOFTWARE);
+void hop_deinit()
+{
+ HOP *p, *next;
+ int i;
+ for (i = 0; i < OP_HASH_SIZE; i++)
+ for(p = hop[i]; p; ) {
+ next = p->next;
+ free(p);
+ p = next;
}
+ free(hop);
+ hop = 0;
}
- for (i = 0; i < nargs; i++) {
- char set;
- if (args[i]->type == VTADDRESS)
- set = 'I';
- else
- set = args[i]->set;
+#endif
+
+int check_op(char *fullname, char *name, SymReg *regs[])
+{
+ int op, nargs;
+ for (nargs = 0; regs[nargs]; nargs++) ;
+ op_fullname(fullname, name, regs, nargs);
+ op = interpreter->op_lib->op_code(fullname, 1);
+ return op;
- *dest++ = '_';
- if (key_index == i)
- *dest++ = 'k';
- *dest++ = tolower(set);
- if (args[i]->type == VTCONST || args[i]->type == VTADDRESS)
- *dest++ = 'c';
}
- *dest = '\0';
+
+int is_op(char *name)
+{
+ return interpreter->op_lib->op_code(name, 0) >= 0;
}
-SymReg * iANY(char * name) {
+Instruction * iANY(char * name, char *fmt, SymReg **regs, int emit) {
char fullname[64];
int i;
int dirs = 0;
- op_t op;
- op_fullname(fullname, name, args, nargs);
- op = op_find_exact(fullname);
- if (!same_op(op, NULLOP)) {
- op_info_t * info = op_info(op);
+ int op;
+ Instruction * ins;
+
+ op_fullname(fullname, name, regs, nargs);
+ op = interpreter->op_lib->op_code(fullname, 1);
+ if (op >= 0) {
+ op_info_t * info = &interpreter->op_info_table[op];
char format[128];
int len;
- if (IMCC_DEBUG) {
- fprintf(stderr, "Op %s (%d, %d)\n", name, op.lib, op.op);
- print_op_info(stderr, info);
- }
- sprintf(format, "%s ", name);
- for (i = 1; i < info->arg_count; i++) {
- switch (info->dirs[i]) {
+ *format = '\0';
+ /* info->arg_count is offset by one, first is opcode
+ * build instruction format
+ * set LV_in / out flags */
+ for (i = 0; i < info->arg_count-1; i++) {
+ switch (info->dirs[i+1]) {
+ case PARROT_ARGDIR_INOUT:
+ /* inout is actually in for imcc, the PMC has to exist
+ * previously, so:
+ * goon
+ */
case PARROT_ARGDIR_IN:
- dirs |= 1 << (i - 1);
+ dirs |= 1 << i ;
break;
case PARROT_ARGDIR_OUT:
- dirs |= 1 << (4 + i - 1);
- break;
-
- case PARROT_ARGDIR_INOUT:
- dirs |= 1 << (i - 1) | 1 << (4 + i - 1);
+ dirs |= 1 << (16 + i);
break;
default:
assert(0);
};
- strcat(format, "%s, ");
+ if (regs[i]->type & VTKEY) {
+ len = strlen(format);
+ len -= 2;
+ format[len] = '\0';
+ strcat(format, "[%s], ");
}
- if (info->jump) {
- /* XXX: assume the jump is relative to the last arg.
- * usually true. */
- dirs |= 1 << (8 + nargs - 2);
+ else
+ strcat(format, "%s, ");
}
len = strlen(format);
len -= 2;
format[len] = '\0';
- emitb(mk_instruction(format, args[0], args[1], args[2], args[3],
- dirs));
- } else {
- fprintf(stderr, "line %ld: no op %s (%s<%d>)\n",
- line, fullname, name, nargs);
- exit(EX_SOFTWARE);
+ if (fmt && *fmt)
+ strcpy(format, fmt);
+ for (i = nargs; i < IMCC_MAX_REGS; i++)
+ regs[i] = 0;
+#if 1
+ debug(1,"%s %s\t%s\n", name, format, fullname);
+#endif
+ /* make the instruction */
+ ins = emitb(_mk_instruction(name, format, regs, dirs));
+ /* fill iin oplib's info */
+ ins->opnum = op;
+ ins->opsize = info->arg_count;
+ /* reset the VTKEY flag and remeber the info in ins->keys */
+ for (i = 0; ins->r[i]; i++)
+ if (ins->r[i]->type & VTKEY) {
+ ins->r[i]->type &= ~VTKEY;
+ ins->keys |= (1<<i);
}
- return NULL;
+ /* set up branch flags */
+ if (info->jump) {
+ if (!strcmp(name, "bsr") || !strcmp(name, "ret")) {
+ /* ignore subcalls and ret
+ * because they saveall
+ */
}
-
-void relop_to_op(int relop, char * op) {
- switch(relop) {
- case RELOP_EQ: strcpy(op, "eq"); return;
- case RELOP_NE: strcpy(op, "ne"); return;
- case RELOP_GT: strcpy(op, "gt"); return;
- case RELOP_GTE: strcpy(op, "ge"); return;
- case RELOP_LT: strcpy(op, "lt"); return;
- case RELOP_LTE: strcpy(op, "le"); return;
- default:
- fprintf(stderr, "relop_to_op: Invalid relop [%d]\n", relop);
- abort();
+ else {
+ /* XXX: assume the jump is relative and to the last arg.
+ * usually true.
+ */
+ ins->type = ITBRANCH | (1 << (nargs-1));
+ if (!strcmp(name, "branch"))
+ ins->type |= IF_goto;
+ }
+ }
+ else if (!strcmp(name, "set") && nargs == 2) {
+ /* set Px, Py: both PMCs have the same address */
+ if (regs[0]->set == 'P' && regs[1]->set == 'P')
+ ins->type |= ITALIAS;
+ }
+ else if (!strcmp(name, "set_addr")) {
+ /* XXX propably a CATCH block */
+ ins->type = ITADDR | IF_r1_branch | ITBRANCH;
+ }
+ } else {
+ fataly(EX_SOFTWARE, "iANY", line,"op not found '%s' (%s<%d>)\n",
+ fullname, name, nargs);
}
+ return NULL;
}
%}
%union {
- int i;
+ int t;
char * s;
SymReg * sr;
+ Instruction *i;
}
-%token <i> CALL GOTO BRANCH ARG RET PRINT IF UNLESS NEW END SAVEALL RESTOREALL
-%token <i> SUB NAMESPACE CLASS ENDCLASS SYM LOCAL PARAM PUSH POP INC DEC
-%token <i> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV DEFINED LOG_XOR
-%token <i> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
-%token <i> GLOBAL ADDR CLONE RESULT RETURN POW
-%token <i> COMMA
-%token <s> EMIT LABEL
-%token <s> IREG NREG SREG PREG IDENTIFIER STRINGC INTC FLOATC
-%type <i> type program subs sub sub_start relop
-%type <s> classname opname
-%type <sr> labels _labels label statements statement
-%type <sr> instruction assignment if_statement labeled_inst
+%token <t> CALL GOTO BRANCH ARG RET PRINT IF UNLESS NEW END SAVEALL RESTOREALL
+%token <t> SUB NAMESPACE CLASS ENDCLASS SYM LOCAL PARAM PUSH POP INC DEC
+%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV DEFINED LOG_XOR
+%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
+%token <t> GLOBAL ADDR CLONE RESULT RETURN POW
+%token <t> COMMA
+%token <s> LABEL
+%token <t> EMIT EOM
+%token <s> IREG NREG SREG PREG IDENTIFIER STRINGC INTC FLOATC REG MACRO
+%token <s> PARROT_OP
+%type <t> type
+%type <i> program subs sub sub_start emit
+%type <s> classname relop
+%type <i> labels _labels label statements statement
+%type <i> instruction assignment if_statement labeled_inst
%type <sr> target reg const var rc string
-%type <sr> vars _vars var_or_i
+%type <sr> key keylist _keylist
+%type <sr> vars _vars var_or_i _var_or_i
+%type <i> pasmcode pasmline pasm_inst
+%type <sr> pasm_args lhs
+%token <sr> VAR
+
%start program
+%expect 2
%%
program:
- subs emit { $$ = 0; }
+ subs { $$ = 0; }
+ ;
+
+
+pasmcode: pasmline
+ | pasmcode pasmline
+ ;
+
+pasmline: labels pasm_inst '\n' { $$ = 0; }
+ ;
+pasm_inst: PARROT_OP { nargs = 0;
+ memset(regs, 0, sizeof(regs)); }
+ pasm_args { $$ = iANY($1,0,regs,1); free($1); }
+ | /* none */ { $$ = 0;}
+
+ ;
+pasm_args:
+ vars
;
emit:
- | EMIT { iEMIT($1); }
+ EMIT pasmcode { $$ = 0 }
+ EOM '\n' { emit_flush(); clear_tables();$$=0 }
;
+nls:
+ '\n'
+ | nls '\n'
+
subs: subs sub
| sub
;
-sub: sub_start statements labels RET
+sub: sub_start statements RET
{
- $$ = 0; iRET();
+ $$ = 0; MK_I("ret", R0());
allocate();
emit_flush();
clear_tables();
}
+ | emit{ $$=0 }
+ | nls { $$=0 }
;
-sub_start: SUB IDENTIFIER
+sub_start: SUB IDENTIFIER '\n'
{ $$ = 0;
- iSUBROUTINE(mk_address($2));
+ iSUBROUTINE(mk_address($2, U_add_uniq_sub));
}
;
@@ -552,45 +470,53 @@
_labels: _labels label
| label
+ | label '\n'
;
-label: LABEL { $$ = iLABEL(mk_address($1)); }
+label: LABEL { $$ = iLABEL(mk_address($1, U_add_uniq_label)); }
;
instruction:
- labels { expect_eol = 1; } labeled_inst '\n' { $$ = $3; }
+ labels labeled_inst '\n' { $$ = $2; }
;
labeled_inst:
assignment
| if_statement
| SYM type IDENTIFIER { mk_ident($3, $2); }
| LOCAL type IDENTIFIER { mk_ident($3, $2); }
- | PARAM type IDENTIFIER { $$ = iPOP(mk_ident($3, $2));}
- | PARAM reg { $$ = iPOP($2); }
- | ARG var { $$ = iARG($2); }
- | RESULT var { $$ = iRESULT($2); }
- | RETURN var { $$ = iRETURN($2); }
- | CALL IDENTIFIER { $$ = iCALL(mk_address($2)); }
- | GOTO IDENTIFIER { $$ = iBRANCH(mk_address($2));}
- | PUSH var { $$ = iPUSH($2); }
- | POP var { $$ = iPOP($2); }
- | INC var { $$ = iINC($2); }
- | DEC var { $$ = iDEC($2); }
- | PRINT var { $$ = iPRINT($2); }
- | SAVEALL { iSAVEALL(); }
- | RESTOREALL { iRESTOREALL(); }
- | END { iEND(); }
- | opname { nargs = 0;
- memset(args, 0, sizeof(args));
+ | LOCAL type VAR { $$ = 0;
+ warning("parser", "file %s line %d: %s already defined\n",
+ sourcefile, line, $3->name); }
+ | PARAM type IDENTIFIER { $$ = MK_I("restore",
+ R1(mk_ident($3, $2)));}
+ | PARAM reg { $$ = MK_I("restore", R1($2)); }
+ | RESULT var { $$ = MK_I("restore", R1($2)); }
+ | POP var { $$ = MK_I("restore", R1($2)); }
+ | ARG var { $$ = MK_I("save", R1($2)); }
+ | PUSH var { $$ = MK_I("save", R1($2)); }
+ | RETURN var { $$ = MK_I("save", R1($2)); }
+ | CALL IDENTIFIER { $$ = MK_I("bsr",
+ R1(mk_address($2, U_add_once)));}
+ | GOTO IDENTIFIER { $$ = MK_I("branch",
+ R1(mk_address($2, U_add_once)));}
+ | INC var { $$ = MK_I("inc",R1($2)); }
+ | DEC var { $$ = MK_I("dec",R1($2)); }
+ | PRINT var { $$ = MK_I("print",R1($2)); }
+ | SAVEALL { $$ = MK_I("saveall" ,R0()); }
+ | RESTOREALL { $$ = MK_I("restoreall" ,R0()); }
+ | END { $$ = MK_I("end" ,R0()); }
+ | PARROT_OP { nargs = 0;
+ memset(regs, 0, sizeof(regs));
}
- vars { $$ = iANY($1); }
+ vars { $$ = iANY($1,0,regs, 1); free($1); }
+ | /* none */ { $$ = 0;}
;
type:
INTV { $$ = 'I'; }
| FLOATV { $$ = 'N'; }
| STRINGV { $$ = 'S'; }
- | classname { $$ = 'P'; }
+ | classname { $$ = 'P'; free($1); }
;
classname:
@@ -598,54 +524,57 @@
;
assignment:
- target '=' var { $$ = iMOVE($1, $3); }
- | target '=' '!' var { $$ = iNOT($1, $4); }
- | target '=' '-' var { $$ = iNEG($1, $4); }
- | target '=' var '+' var { $$ = iADD($1, $3, $5); }
- | target '=' var '-' var { $$ = iSUB($1, $3, $5); }
- | target '=' var '*' var { $$ = iMUL($1, $3, $5); }
- | target '=' var POW var { $$ = iPOW($1, $3, $5); }
- | target '=' var '/' var { $$ = iDIV($1, $3, $5); }
- | target '=' var '%' var { $$ = iMOD($1, $3, $5); }
- | target '=' var '.' var { $$ = iCONCAT($1, $3, $5); }
- | target '=' var SHIFT_LEFT var { $$ = iSHL($1, $3, $5); }
- | target '=' var SHIFT_RIGHT var { $$ = iSHR($1, $3, $5); }
- | target '=' var LOG_XOR var { $$ = iXOR($1, $3, $5); }
- | target '=' var '&' var { $$ = iBAND($1, $3, $5); }
- | target '=' var '|' var { $$ = iBOR($1, $3, $5); }
- | target '=' var '~' var { $$ = iBXOR($1, $3, $5); }
- | target '=' var '[' var ']' { $$ = iINDEXFETCH($1, $3, $5); }
- | var '[' var ']' '=' var { $$ = iINDEXSET($1, $3, $6); }
+ target '=' var { $$ = MK_I("set", R2($1, $3)); }
+ | target '=' '!' var { $$ = MK_I("not", R2($1, $4));}
+ | target '=' '-' var { $$ = MK_I("neg", R2($1, $4));}
+ | target '=' var '+' var { $$ = MK_I("add", R3($1, $3, $5)); }
+ | target '=' var '-' var { $$ = MK_I("sub", R3($1, $3, $5)); }
+ | target '=' var '*' var { $$ = MK_I("mul", R3($1, $3, $5)); }
+ | target '=' var POW var { $$ = MK_I("pow", R3($1, $3, $5)); }
+ | target '=' var '/' var { $$ = MK_I("div", R3($1, $3, $5)); }
+ | target '=' var '%' var { $$ = MK_I("mod", R3($1, $3, $5)); }
+ | target '=' var '.' var { $$ = MK_I("concat", R3($1,$3,$5)); }
+ | target '=' var SHIFT_LEFT var { $$ = MK_I("shl", R3($1, $3, $5)); }
+ | target '=' var SHIFT_RIGHT var { $$ = MK_I("shr", R3($1, $3, $5)); }
+ | target '=' var LOG_XOR var { $$ = MK_I("xor", R3($1, $3, $5)); }
+ | target '=' var '&' var { $$ = MK_I("band", R3($1, $3, $5)); }
+ | target '=' var '|' var { $$ = MK_I("bor", R3($1, $3, $5)); }
+ | target '=' var '~' var { $$ = MK_I("bxor", R3($1, $3, $5)); }
+ | target '=' var '[' keylist ']'{ $$ = iINDEXFETCH($1, $3, $5); }
+ | var '[' keylist ']' '=' var { $$ = iINDEXSET($1, $3, $6); }
| target '=' NEW classname { $$ = iNEW($1, $4); }
- | target '=' DEFINED var { $$ = iDEFINED($1, $4); }
- | target '=' CLONE var { $$ = iCLONE($1, $4); }
- | target '=' ADDR IDENTIFIER { $$ = iSET_ADDR($1, mk_address($4)); }
- | target '=' GLOBAL string { $$ = iGET_GLOBAL($1, $4); }
- | GLOBAL string '=' var { $$ = iSET_GLOBAL($2, $4); }
+ | target '=' DEFINED var { $$ = MK_I("defined %s, %s",R2($1,$4)); }
+ | target '=' CLONE var { $$ = MK_I("clone %s, %s",R2($1, $4));
+ }
+ | target '=' ADDR IDENTIFIER { $$ = MK_I("set_addr",
+ R2($1, mk_address($4,U_add_once))); }
+ | target '=' GLOBAL string { $$ = MK_I("find_global",R2($1,$4)); }
+ | GLOBAL string '=' var { $$ = MK_I("store_global",R2($2,$4)); }
;
if_statement:
- IF var relop var GOTO IDENTIFIER
- { $$ = iIF($3, $2, $4, mk_address($6)); }
- | IF var GOTO IDENTIFIER
- { $$ = iIF1("if",$2, mk_address($4)); }
- | UNLESS var GOTO IDENTIFIER
- { $$ = iIF1("unless", $2, mk_address($4)); }
+ IF var relop var GOTO IDENTIFIER { $$=MK_I($3,R3($2,$4,
+ mk_address($6,U_add_once))); }
+ | IF var GOTO IDENTIFIER {$$= MK_I("if", R2($2,
+ mk_address($4, U_add_once))); }
+ | UNLESS var GOTO IDENTIFIER {$$= MK_I("unless",R2($2,
+ mk_address($4, U_add_once))); }
;
relop:
- RELOP_EQ { $$ = RELOP_EQ; }
- | RELOP_NE { $$ = RELOP_NE; }
- | RELOP_GT { $$ = RELOP_GT; }
- | RELOP_GTE { $$ = RELOP_GTE; }
- | RELOP_LT { $$ = RELOP_LT; }
- | RELOP_LTE { $$ = RELOP_LTE; }
+ RELOP_EQ { $$ = "eq"; }
+ | RELOP_NE { $$ = "ne"; }
+ | RELOP_GT { $$ = "gt"; }
+ | RELOP_GTE { $$ = "ge"; }
+ | RELOP_LT { $$ = "lt"; }
+ | RELOP_LTE { $$ = "le"; }
;
-opname: IDENTIFIER
- ;
-target: IDENTIFIER { $$ = get_sym($1); free($1); }
+target: VAR
+ | reg
+ ;
+lhs: VAR
| reg
;
@@ -653,19 +582,34 @@
| _vars { $$ = $1; }
;
-_vars: _vars COMMA var_or_i { args[nargs++] = $3; $$ = args[0]; }
- | var_or_i { args[nargs++] = $1; $$ = $1; }
+_vars: _vars COMMA _var_or_i { $$ = regs[0]; }
+ | _var_or_i
;
+_var_or_i: var_or_i { regs[nargs++] = $1 }
+ | lhs '[' keylist ']' { regs[nargs++] = $1;
+ regs[nargs++] = $3; $$= $1; }
+ ;
var_or_i:
- IDENTIFIER { $$ = mk_address($1); }
- | rc
+ IDENTIFIER { $$ = mk_address($1, U_add_once); }
+ | var
+ | MACRO { $$ = macro($1+1); free($1)}
;
-var: IDENTIFIER { $$ = get_sym($1); free($1); }
+var: VAR
| rc
;
+keylist: { nkeys=0 }
+ _keylist { $$ = link_keys(nkeys, keys); }
+ ;
+
+_keylist: key { keys[nkeys++] = $1; }
+ | _keylist ';' key { keys[nkeys++] = $3; $$ = keys[0] }
+ ;
+
+key: var
+
rc: reg
| const
;
@@ -674,6 +618,7 @@
| NREG { $$ = mk_symreg($1, 'N'); }
| SREG { $$ = mk_symreg($1, 'S'); }
| PREG { $$ = mk_symreg($1, 'P'); }
+ | REG { $$ = mk_pasm_reg($1); }
;
const: INTC { $$ = mk_const($1, 'I'); }
@@ -687,86 +632,303 @@
%%
extern FILE *yyin;
-int IMCC_DEBUG = 0;
+int IMCC_DEBUG;
+int gc_off;
+static int pbc, write_pbc;
+char* output;
-int main(int argc, char * argv[])
+static void usage(FILE *fp)
{
- char* output;
- while (argc > 1) {
- if(! strcmp (argv[1], "--debug")) {
- IMCC_DEBUG = 1;
- argc--;
- argv++;
- continue;
+ fprintf(fp, "imcc [-h|--help] [-V|--version] [-d|--debug] [-v|--verbose]\n");
+ fprintf(fp, "\t[-y|--yydebug] [-r|--runpbc] [-t|--trace] [-o outfile]
infile\n");
+ exit(fp != stdout);
}
- if(! strcmp (argv[1], "--yydebug")) {
- yydebug = 1;
- argc--;
- argv++;
- continue;
+
+
+static void help()
+{
+ usage(stdout);
}
- if(! strcmp (argv[1], "--verbose")) {
- IMCC_VERBOSE = 1;
- argc--;
- argv++;
- continue;
+
+static void version()
+{
+ printf("imcc version " IMCC_VERSION "\n");
+ exit(0);
}
- if(! strcmp (argv[1], "--life-info")) {
- IMCC_LIFE_INFO = 1;
- argc--;
- argv++;
- continue;
+
+#define setopt(flag) Parrot_setflag(interpreter, flag, (*argv)[0]+2);
+#define unsetopt(flag) Parrot_setflag(interpreter, flag, 0)
+
+/* most stolen from test_main.c */
+char *
+parseflags(Parrot_Interp interpreter, int *argc, char **argv[])
+{
+ if (*argc == 1) {
+ usage(stderr);
}
+
+ /* skip the program name arg */
+ (*argc)--;
+ (*argv)++;
+
+#ifdef HAVE_COMPUTED_GOTO
+ setopt(PARROT_CGOTO_FLAG);
+#endif
+
+ while ((*argc) && (*argv)[0][0] == '-') {
+ switch ((*argv)[0][1]) {
+ case 'b':
+ setopt(PARROT_BOUNDS_FLAG);
+ break;
+ case 'j':
+ setopt(PARROT_JIT_FLAG);
+ break;
+ case 'p':
+ setopt(PARROT_PROFILE_FLAG);
+ break;
+ case 'P':
+ setopt(PARROT_PREDEREF_FLAG);
+ break;
+ case 'g':
+ unsetopt(PARROT_CGOTO_FLAG);
+ break;
+ case 't':
+ setopt(PARROT_TRACE_FLAG);
+ break;
+ case 'd':
+ setopt(PARROT_DEBUG_FLAG);
+ IMCC_DEBUG++;
break;
+ case 'w':
+ Parrot_setwarnings(interpreter, PARROT_WARNINGS_ALL_FLAG);
+ break;
+ case 'G':
+ gc_off = 1;
+ break;
+ case '.': /* Give Windows Parrot hackers an opportunity to
+ * attach a debuggger. */
+ fgetc(stdin);
+ break;
+ case 'h':
+ usage(stdin);
+ break;
+ case 'V':
+ version();
+ break;
+ case 'r':
+ pbc = 1;
+ break;
+ case 'c':
+ write_pbc = 1;
+ break;
+ case 'v':
+ IMCC_VERBOSE++;
+ break;
+ case 'y':
+ yydebug = 1;
+ break;
+ case 'o':
+ if ((*argv)[0][2])
+ output = str_dup((*argv)[0]+2);
+ else {
+ (*argc)--;
+ output = str_dup((++(*argv))[0]);
}
+ break;
- if (argc <= 1) {
- fprintf(stderr, "No source file specified.\n" );
- exit(EX_NOINPUT);
+ case 'O':
+ strncpy(optimizer_opt, (*argv)[0]+2,sizeof(optimizer_opt));
+ optimizer_opt[sizeof(optimizer_opt)-1] = '\0';
+ break;
+ case '-':
+ /* XXX long options */
+ (*argc)--;
+ (*argv)++;
+
+ goto OUT;
+ case '\0': /* bare '-' means read from stdin */
+ goto OUT;
+ default:
+ fatal(1, "main", "Invalid flag %s used\n", (*argv)[0]);
+ exit(1);
}
- if(!(yyin = fopen(argv[1], "r"))) {
- fprintf(stderr, "Error reading source file %s.\n", argv[1] );
- exit(EX_IOERR);
+ (*argc)--;
+ (*argv)++;
}
- if (IMCC_DEBUG)
- fprintf(stderr, "loading libs...");
+ OUT:
- op_load_file("../../blib/lib/libparrot" PARROT_DLL_EXTENSION);
- op_load_lib("core", PARROT_MAJOR_VERSION,
- PARROT_MINOR_VERSION,
- PARROT_PATCH_VERSION);
- if (IMCC_DEBUG)
- fprintf(stderr, "done\n");
+ return (*argv)[0];
+}
- line = 1;
+#ifdef OPTEST
+#define USE_HOP
- if (IMCC_DEBUG)
- fprintf(stderr, "Pass 1: Starting parse...\n");
+#define OP_HASH_SIZE 1511
+typedef struct hop {
+ op_info_t * info;
+ struct hop *next;
+} HOP;
+static HOP **hop;
- if (argc > 2) {
- output = argv[2];
+static void store_op(op_info_t *info) {
+ HOP *p = malloc(sizeof(HOP));
+ int index = hash_str(info->full_name) % OP_HASH_SIZE;
+ p->info = info;
+ p->next = hop[index];
+ hop[index] = p;
}
- else {
- output = "a.pasm";
+static void hop_init() {
+ int i;
+ op_info_t * info = interpreter->op_info_table;
+ for (i = 0; i < interpreter->op_count; i++)
+ store_op(info + i);
+}
+int get_op(const char * name) {
+ HOP * p;
+ int index = hash_str(name) % OP_HASH_SIZE;
+ if (!hop) {
+ hop = calloc(OP_HASH_SIZE, sizeof(HOP*));
+ hop_init();
+ }
+ for(p = hop[index]; p; p = p->next) {
+ if(!strcmp(name, p->info->full_name))
+ return p->info - interpreter->op_info_table;
+ }
+ return -1;
+}
+void hop_deinit()
+{
+ HOP *p, *next;
+ int i;
+ for (i = 0; i < OP_HASH_SIZE; i++)
+ for(p = hop[i]; p; ) {
+ next = p->next;
+ free(p);
+ p = next;
+ }
+ free(hop);
+ hop = 0;
}
- freopen(output, "w", stdout);
- yyparse();
+static void test_ops()
+{
+ int i,j,n = interpreter->op_count;
+ op_info_t * info = interpreter->op_info_table;
+ int op;
+
+ printf("testing op_code for %d ops 10000 times\n", n);
+ /* 10.000 runs for 889 ops: 8.3-8.5 s */
+ for (i = 0; i < n; i++) {
+ for (j = 0; j < 10000 ; j++) {
+#ifdef USE_HOP
+ op = get_op(info[i].full_name);
+ if (op != i) {
+ printf("Op %d %s not found\n", i, info[i].full_name);
+ exit(1);
+ }
+#else
+ op = interpreter->op_lib->op_code(info[i].full_name);
+ if (i != op) {
+ printf("Op %d %s not found\n", i, info[i].full_name);
+ exit(1);
+ }
+#endif
+ }
+ }
+#ifdef USE_HOP
+ hop_deinit();
+#endif
+}
- /* Flush any pending code such as .emits */
- emit_flush();
+#endif
- fclose(yyin);
- fclose(stdout);
- op_close_lib();
+int main(int argc, char * argv[])
+{
+ void * stacktop;
+ struct PackFile *pf;
+
+ interpreter = Parrot_new();
+ Parrot_init(interpreter, stacktop);
+ pf = PackFile_new();
+ interpreter->code = pf;
+#ifdef OPTEST
+ test_ops();
+ exit(0);
+#endif
+ interpreter->DOD_block_level++;
+
+ sourcefile = parseflags(interpreter, &argc, &argv);
+
+ /* default optimizations, s. optimizer.c */
+ if (!*optimizer_opt)
+ strcpy(optimizer_opt, "0");
+
+ if (!sourcefile || !*sourcefile) {
+ fatal(EX_NOINPUT, "main", "No source file specified.\n" );
+ }
+ else if (!strcmp(sourcefile, "-"))
+ yyin = stdin;
+ else
+ if(!(yyin = fopen(sourcefile, "r"))) {
+ fatal(EX_IOERR, "main", "Error reading source file %s.\n",
+ sourcefile);
+ }
+
+ if (!output)
+ output = str_dup(pbc ? "a.pbc" : "a.pasm");
if (IMCC_VERBOSE) {
- fprintf(stderr, "%ld lines compiled.\n", line);
- fprintf(stderr, "Compiling assembly module %s\n", output);
+ info(1,"Reading %s", yyin == stdin ? "stdin":sourcefile);
+ if (pbc)
+ info(1, ", executing");
+ if (write_pbc)
+ info(1, " and writing %s\n", output);
+ else
+ info(1,"\n");
+ }
+ info(1, "using optimization '%s'\n", optimizer_opt);
+
+ line = 1;
+ emit_open(write_pbc | pbc, output);
+
+ debug(1, "Starting parse...\n");
+
+ yyparse();
+ emit_close();
+ fclose(yyin);
+
+ info(1, "%ld lines compiled.\n", line);
+ if (write_pbc) {
+ size_t size;
+ opcode_t *packed;
+ FILE *fp;
+
+ size = PackFile_pack_size(interpreter->code);
+ info(1, "packed code %d bytes\n", size);
+ packed = (opcode_t*) mem_sys_allocate(size);
+ if (!packed)
+ fatal(1, "main", "Out of mem\n");
+ PackFile_pack(interpreter->code, packed);
+ if ((fp = fopen(output, "wb")) == 0)
+ fatal(1, "main", "Couldn't open %s\n", output);
+ if ((1 != fwrite(packed, size, 1, fp)) )
+ fatal(1, "main", "Couldn't write %s\n", output);
+ fclose(fp);
+ info(1, "%s written.\n", output);
+ free(packed);
+ }
+ if (pbc == 1) {
+ if (!gc_off)
+ interpreter->DOD_block_level--;
+ info(1, "Running...\n");
+ Parrot_runcode(interpreter, argc, argv);
+ /* XXX no return value :-( */
+ Parrot_destroy(interpreter);
}
+ free(output);
return 0;
}
@@ -778,3 +940,13 @@
fprintf(stderr, "Didn't create output asm.\n" );
exit(EX_UNAVAILABLE);
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
